diff --git a/.vscode/extensions.json b/.vscode/extensions.json deleted file mode 100644 index 344f76e..0000000 --- a/.vscode/extensions.json +++ /dev/null @@ -1,5 +0,0 @@ -{ - "recommendations": [ - "Posit.air-vscode" - ] -} diff --git a/.vscode/settings.json b/.vscode/settings.json deleted file mode 100644 index a9f69fe..0000000 --- a/.vscode/settings.json +++ /dev/null @@ -1,10 +0,0 @@ -{ - "[r]": { - "editor.formatOnSave": true, - "editor.defaultFormatter": "Posit.air-vscode" - }, - "[quarto]": { - "editor.formatOnSave": true, - "editor.defaultFormatter": "quarto.quarto" - } -} diff --git a/CITATION.cff b/CITATION.cff index 2857c6f..86a772b 100644 --- a/CITATION.cff +++ b/CITATION.cff @@ -1,14 +1,14 @@ -# -------------------------------------------- -# CITATION file created with {cffr} R package +# ------------------------------------------------ +# CITATION.cff file created with {cffr} R package # See also: https://docs.ropensci.org/cffr/ -# -------------------------------------------- +# ------------------------------------------------ cff-version: 1.2.0 message: 'To cite package "rsmatrix" in publications use:' type: software license: MIT title: 'rsmatrix: Matrices for Repeat-Sales Price Indexes' -version: 0.2.10 +version: 0.2.11 doi: 10.5281/zenodo.10110159 identifiers: - type: doi @@ -31,7 +31,7 @@ preferred-citation: year: '2026' doi: 10.5281/zenodo.10110159 url: https://cran.r-project.org/package=rsmatrix - notes: R package version 0.2.10 + notes: R package version 0.2.11 repository: https://CRAN.R-project.org/package=rsmatrix repository-code: https://github.com/marberts/rsmatrix url: https://marberts.github.io/rsmatrix/ @@ -55,10 +55,13 @@ references: url: https://www.R-project.org/ authors: - name: R Core Team + website: https://ror.org/02zz1nj61 institution: name: R Foundation for Statistical Computing + website: https://ror.org/05qewa988 address: Vienna, Austria year: '2026' + doi: 10.32614/R.manuals version: '>= 4.0' - type: software title: Matrix @@ -81,88 +84,18 @@ references: doi: 10.32614/CRAN.package.Matrix version: '>= 1.5-0' - type: software - title: knitr - abstract: 'knitr: A General-Purpose Package for Dynamic Report Generation in R' + title: litedown + abstract: 'litedown: A Lightweight Version of R Markdown' notes: Suggests - url: https://yihui.org/knitr/ - repository: https://CRAN.R-project.org/package=knitr + url: https://github.com/yihui/litedown + repository: https://CRAN.R-project.org/package=litedown authors: - family-names: Xie given-names: Yihui email: xie@yihui.name orcid: https://orcid.org/0000-0003-0645-5666 year: '2026' - doi: 10.32614/CRAN.package.knitr -- type: software - title: rmarkdown - abstract: 'rmarkdown: Dynamic Documents for R' - notes: Suggests - url: https://pkgs.rstudio.com/rmarkdown/ - repository: https://CRAN.R-project.org/package=rmarkdown - authors: - - family-names: Allaire - given-names: JJ - email: jj@posit.co - - family-names: Xie - given-names: Yihui - email: xie@yihui.name - orcid: https://orcid.org/0000-0003-0645-5666 - - family-names: Dervieux - given-names: Christophe - email: cderv@posit.co - orcid: https://orcid.org/0000-0003-4474-2498 - - family-names: McPherson - given-names: Jonathan - email: jonathan@posit.co - - family-names: Luraschi - given-names: Javier - - family-names: Ushey - given-names: Kevin - email: kevin@posit.co - - family-names: Atkins - given-names: Aron - email: aron@posit.co - - family-names: Wickham - given-names: Hadley - email: hadley@posit.co - - family-names: Cheng - given-names: Joe - email: joe@posit.co - - family-names: Chang - given-names: Winston - email: winston@posit.co - - family-names: Iannone - given-names: Richard - email: rich@posit.co - orcid: https://orcid.org/0000-0003-3925-190X - year: '2026' - doi: 10.32614/CRAN.package.rmarkdown -- type: software - title: testthat - abstract: 'testthat: Unit Testing for R' - notes: Suggests - url: https://testthat.r-lib.org - repository: https://CRAN.R-project.org/package=testthat - authors: - - family-names: Wickham - given-names: Hadley - email: hadley@posit.co - year: '2026' - doi: 10.32614/CRAN.package.testthat - version: '>= 3.0.0' -- type: software - title: gpindex - abstract: 'gpindex: Generalized Price and Quantity Indexes' - notes: Suggests - url: https://marberts.github.io/gpindex/ - repository: https://CRAN.R-project.org/package=gpindex - authors: - - family-names: Martin - given-names: Steve - email: marberts@protonmail.com - orcid: https://orcid.org/0000-0003-2544-9480 - year: '2026' - doi: 10.32614/CRAN.package.gpindex + doi: 10.32614/CRAN.package.litedown - type: software title: piar abstract: 'piar: Price Index Aggregation' @@ -176,5 +109,34 @@ references: orcid: https://orcid.org/0000-0003-2544-9480 year: '2026' doi: 10.32614/CRAN.package.piar - version: '>= 0.8.2' +- type: software + title: spelling + abstract: 'spelling: Tools for Spell Checking in R' + notes: Suggests + url: https://ropensci.r-universe.dev/spelling + repository: https://CRAN.R-project.org/package=spelling + authors: + - family-names: Ooms + given-names: Jeroen + email: jeroenooms@gmail.com + orcid: https://orcid.org/0000-0002-4035-0289 + - family-names: Hester + given-names: Jim + email: james.hester@rstudio.com + year: '2026' + doi: 10.32614/CRAN.package.spelling +- type: software + title: tinytest + abstract: 'tinytest: Lightweight and Feature Complete Unit Testing Framework' + notes: Suggests + url: https://github.com/markvanderloo/tinytest + repository: https://CRAN.R-project.org/package=tinytest + authors: + - family-names: Loo + given-names: Mark + name-particle: van der + email: mark.vanderloo@gmail.com + orcid: https://orcid.org/0000-0002-9807-4686 + year: '2026' + doi: 10.32614/CRAN.package.tinytest diff --git a/CONTRIBUTING.md b/CONTRIBUTING.md index 73febcb..6e90ca3 100644 --- a/CONTRIBUTING.md +++ b/CONTRIBUTING.md @@ -40,6 +40,6 @@ When making a pull request, please: 3. Use `roxygen2` for documentation; -4. Use `testthat` for unit tests; +4. Use `tinytest` for unit tests; 5. Ensure your changes pass `R CMD check`. diff --git a/CRAN-SUBMISSION b/CRAN-SUBMISSION index b94012d..a3268f6 100644 --- a/CRAN-SUBMISSION +++ b/CRAN-SUBMISSION @@ -1,3 +1,3 @@ -Version: 0.2.10 -Date: 2026-05-08 02:45:56 UTC -SHA: a3352faa6f4ccff88b8c96301a4d6e3e546eeed4 +Version: 0.2.11 +Date: 2026-08-01 04:43:11 UTC +SHA: 43476e4ff465ecdd18b72c71502e8d277e0d9e9d diff --git a/DESCRIPTION b/DESCRIPTION index 55739c4..6842ebc 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: rsmatrix Title: Matrices for Repeat-Sales Price Indexes -Version: 0.2.10 +Version: 0.2.11 Authors@R: c( person(given = "Steve", family = "Martin", role = c("aut", "cre", "cph"), email = "marberts@protonmail.com", @@ -11,17 +11,16 @@ Description: Calculate the matrices in foundation for many repeat-sales price indexes. Depends: R (>= 4.0) Imports: Matrix (>= 1.5-0) -Suggests: - knitr, - rmarkdown, - testthat (>= 3.0.0), - gpindex, - piar (>= 0.8.2) +Suggests: + litedown, + piar, + spelling, + tinytest License: MIT + file LICENSE Encoding: UTF-8 URL: https://marberts.github.io/rsmatrix/, https://github.com/marberts/rsmatrix BugReports: https://github.com/marberts/rsmatrix/issues -Config/testthat/edition: 3 -VignetteBuilder: knitr +VignetteBuilder: litedown Roxygen: list(markdown = TRUE) Config/roxygen2/version: 8.0.0 +Language: en-US diff --git a/NEWS.md b/NEWS.md index f79e05c..3db64e9 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,3 +1,7 @@ +## rsmatrix 0.2.11 + +- Now using {litedown} and {tinytest}. No user-facing changes. + ## rsmatrix 0.2.10 - Fixed failing check on CRAN. diff --git a/R/rs_matrix.R b/R/rs_matrix.R index a387833..403eca3 100644 --- a/R/rs_matrix.R +++ b/R/rs_matrix.R @@ -1,81 +1,3 @@ -#' Test if inputs have the same length -#' @noRd -different_lengths <- function(...) { - res <- lengths(list(...)) - any(res != res[1L]) -} - -#' Compute the Z matrix (internal) -#' @noRd -rs_z_ <- function(t2, t1, f = NULL, sparse = FALSE) { - # t2 and t1 are coerced into characters prior to taking the union - # so that both dates and factors are treated the same. - lev2 <- unique(as.character(t2)) - lev1 <- unique(as.character(t1)) - lev <- sort.int(unique(c(lev2, lev1))) # usually faster than base::union() - t2 <- factor(t2, lev) - t1 <- factor(t1, lev) - if (any(unclass(t2) <= unclass(t1))) { - warning( - "all elements of 't2' should be greater than the corresponding ", - "elements in 't1'" - ) - } - - # Make row names before interacting with f. - nm <- if (!is.null(names(t2))) { - names(t2) - } else if (!is.null(names(t1))) { - names(t1) - } else if (!is.null(names(f))) { - names(f) - } else { - seq_along(t2) - } - - if (!is.null(f)) { - f <- as.factor(f) - t2 <- interaction(f, t2) - t1 <- interaction(f, t1) - lev <- levels(t2) - } - - # Calculate Z. - dims <- c(length(nm), length(lev)) - attributes(t2) <- NULL - attributes(t1) <- NULL - non_zero <- which(t2 != t1) - i <- seq_along(t2)[non_zero] - t2 <- t2[non_zero] - t1 <- t1[non_zero] - if (sparse) { - res <- Matrix::sparseMatrix( - rep.int(i, 2), - c(t2, t1), - x = rep(c(1, -1), each = length(i)), - dims = dims - ) - } else { - res <- rep.int(0, prod(dims)) - res[(t2 - 1L) * dims[1L] + i] <- 1 - res[(t1 - 1L) * dims[1L] + i] <- -1 - dim(res) <- dims - } - - if (length(lev) > 0L) { - colnames(res) <- lev - rownames(res) <- nm - } - - res -} - -#' Compute X matrix (internal) -#' @noRd -rs_x_ <- function(z, p2, p1) { - (z > 0) * p2 - (z < 0) * p1 -} - #' Shiller's repeat-sales matrices #' #' Create a function to compute the \eqn{Z}, \eqn{X}, \eqn{y}, and \eqn{Y} @@ -92,16 +14,20 @@ rs_x_ <- function(z, p2, p1) { #' case. Similarly, it should always be the case that `t2 > t1`, otherwise #' a warning is given. #' -#' @param t2,t1 A pair of vectors giving the time period of the second and +#' @export +#' +#' @param t2,t1 `[Date | character]` A pair of vectors giving the time period of +#' the second and #' first sale, respectively. Usually a vector of dates, but other values are #' possible if they can be coerced to character vectors and sorted in #' chronological order (i.e., with [`order()`]). -#' @param p2,p1 A pair of numeric vectors giving the price of the second and -#' first sale, respectively. -#' @param f An optional factor the same length as `t1` and `t2`, or a +#' @param p2,p1 `[numeric > 0]` A pair of numeric vectors giving the price of +#' the second and first sale, respectively. +#' @param f `[factor]` An optional factor the same length as `t1` and `t2`, or a #' vector to be turned into a factor, that is used to group sales. -#' @param sparse Should sparse matrices from the \pkg{Matrix} package be used -#' (faster for large datasets), or regular dense matrices (the default)? +#' @param sparse `[logical(1)]` Should sparse matrices from the \pkg{Matrix} +#' package be used (faster for large datasets), or regular dense matrices +#' (the default)? #' #' @returns #' A function that takes a single argument naming the desired matrix. @@ -166,8 +92,6 @@ rs_x_ <- function(z, p2, p1) { #' mat <- with(x, rs_matrix(date, date_prev, price, price_prev, group)) #' b <- solve(crossprod(mat("Z"), mat("X")), crossprod(mat("Z"), mat("Y")))[, 1] #' 100 / b -#' -#' @export rs_matrix <- function(t2, t1, p2, p1, f = NULL, sparse = FALSE) { t2 <- as.character(t2) t1 <- as.character(t1) @@ -176,22 +100,22 @@ rs_matrix <- function(t2, t1, p2, p1, f = NULL, sparse = FALSE) { if (is.null(f)) { if (different_lengths(t2, t1, p2, p1)) { - stop("'t2', 't1', 'p2', and 'p1' must be the same length") + stop("`t2`, `t1`, `p2`, and `p1` must be the same length") } if (anyNA(t2) || anyNA(t1)) { - stop("'t2' and 't1' cannot contain NAs") + stop("`t2` and `t1` cannot contain NAs") } } else { f <- as.factor(f) if (different_lengths(t2, t1, p2, p1, f)) { - stop("'t2', 't1', 'p2', 'p1', and 'f' must be the same length") + stop("`t2`, `t1`, `p2`, `p1`, and `f` must be the same length") } if (anyNA(t2) || anyNA(t1) || anyNA(f)) { - stop("'t2', 't1', and 'f' cannot contain NAs") + stop("`t2`, `t1`, and `f` cannot contain NAs") } } - z <- rs_z_(t2, t1, f, sparse) + z <- .rs_z(t2, t1, f, sparse) # Number of columns that need to be removed for base period. n <- max(1L, nlevels(f)) * (ncol(z) > 0) @@ -199,11 +123,11 @@ rs_matrix <- function(t2, t1, p2, p1, f = NULL, sparse = FALSE) { switch( match.arg(matrix), Z = z[, -seq_len(n), drop = FALSE], - X = rs_x_(z[, -seq_len(n), drop = FALSE], p2, p1), + X = .rs_x(z[, -seq_len(n), drop = FALSE], p2, p1), y = structure(log(p2 / p1), names = rownames(z)), # rowSums() gets the single value in the base period # for each group. - Y = -Matrix::rowSums(rs_x_(z[, seq_len(n), drop = FALSE], p2, p1)) + Y = -Matrix::rowSums(.rs_x(z[, seq_len(n), drop = FALSE], p2, p1)) ) } @@ -212,3 +136,81 @@ rs_matrix <- function(t2, t1, p2, p1, f = NULL, sparse = FALSE) { environment(res) <- list2env(enc, parent = getNamespace("rsmatrix")) res } + +#' Test if inputs have the same length +#' @noRd +different_lengths <- function(...) { + res <- lengths(list(...)) + any(res != res[1L]) +} + +#' Compute the Z matrix (internal) +#' @noRd +.rs_z <- function(t2, t1, f = NULL, sparse = FALSE) { + # t2 and t1 are coerced into characters prior to taking the union + # so that both dates and factors are treated the same. + lev2 <- unique(as.character(t2)) + lev1 <- unique(as.character(t1)) + lev <- sort.int(unique(c(lev2, lev1))) # usually faster than base::union() + t2 <- factor(t2, lev) + t1 <- factor(t1, lev) + if (any(unclass(t2) <= unclass(t1))) { + warning( + "all elements of `t2` should be greater than the corresponding ", + "elements in `t1`" + ) + } + + # Make row names before interacting with f. + nm <- if (!is.null(names(t2))) { + names(t2) + } else if (!is.null(names(t1))) { + names(t1) + } else if (!is.null(names(f))) { + names(f) + } else { + seq_along(t2) + } + + if (!is.null(f)) { + f <- as.factor(f) + t2 <- interaction(f, t2) + t1 <- interaction(f, t1) + lev <- levels(t2) + } + + # Calculate Z. + dims <- c(length(nm), length(lev)) + attributes(t2) <- NULL + attributes(t1) <- NULL + non_zero <- which(t2 != t1) + i <- seq_along(t2)[non_zero] + t2 <- t2[non_zero] + t1 <- t1[non_zero] + if (sparse) { + res <- Matrix::sparseMatrix( + rep.int(i, 2), + c(t2, t1), + x = rep(c(1, -1), each = length(i)), + dims = dims + ) + } else { + res <- rep.int(0, prod(dims)) + res[(t2 - 1L) * dims[1L] + i] <- 1 + res[(t1 - 1L) * dims[1L] + i] <- -1 + dim(res) <- dims + } + + if (length(lev) > 0L) { + colnames(res) <- lev + rownames(res) <- nm + } + + res +} + +#' Compute X matrix (internal) +#' @noRd +.rs_x <- function(z, p2, p1) { + (z > 0) * p2 - (z < 0) * p1 +} diff --git a/R/rs_pairs.R b/R/rs_pairs.R index e047da2..6d97b13 100644 --- a/R/rs_pairs.R +++ b/R/rs_pairs.R @@ -3,14 +3,17 @@ #' Turn repeat-sales data into sales pairs that are suitable for making #' repeat-sales matrices. #' -#' @param period A vector that gives the time period for each sale. Usually a +#' @export +#' +#' @param period `[Date | factor]` A vector that gives the time period for each +#' sale. Usually a #' date vector, or a factor with the levels in chronological order, but other #' values are possible if they can be sorted in chronological order (i.e., #' with [order()]). -#' @param product A vector that gives the product identifier for each sale. -#' Usually a factor or vector of integer codes for each product. -#' @param match_first Should products in the first period match with -#' themselves (the default)? +#' @param product `[factor]` A vector that gives the product identifier for each +#' sale. Usually a factor or vector of integer codes for each product. +#' @param match_first `[logical(1)]` Should products in the first period match +#' with themselves (the default)? #' #' @returns #' A numeric vector of indices giving the position of the previous sale @@ -42,11 +45,9 @@ #' x[c("date_prev", "price_prev")] <- x[c("date", "price")][pairs, ] #' #' x -#' -#' @export rs_pairs <- function(period, product, match_first = TRUE) { if (length(product) != length(period)) { - stop("'period' and 'product' must be the same length") + stop("`period` and `product` must be the same length") } # != is slow for factors with many levels, so use the integer codes. diff --git a/R/rs_var.R b/R/rs_var.R index 1a25a3b..43c06bd 100644 --- a/R/rs_var.R +++ b/R/rs_var.R @@ -1,9 +1,3 @@ -#' Stata's degrees-of-freedom correction (internal) -#' @noRd -sss <- function(n, k, g) { - g / (g - 1L) * (n - 1L) / (n - k) -} - #' Robust variance matrix for repeat-sales indexes #' #' Convenience function to compute a cluster-robust variance matrix for a @@ -18,18 +12,21 @@ sss <- function(n, k, g) { #' matrix proposed by Shiller (1991, section II) when a property sells more #' than twice. #' -#' This function gives the same result as `vcovHC(x, type = 'sss', cluster +#' This function gives the same result as `vcovHC(x, type = "sss", cluster #' = 'group')` from the \pkg{plm} package. #' -#' @param u An \eqn{n \times 1}{n x 1} vector of residuals from a linear -#' regression. -#' @param Z An \eqn{n \times k}{n x k} matrix of instruments. -#' @param X An \eqn{n \times k}{n x k} matrix of covariates. -#' @param ids A factor of length \eqn{n}, or something that can be coerced into -#' one, that groups observations in `u`. By default each observation -#' belongs to its own group. -#' @param df An optional degrees of freedom correction. Default is Stata's -#' small sample degrees of freedom correction. +#' @export rs_var +#' @importMethodsFrom Matrix solve crossprod tcrossprod +#' +#' @param u `[numeric]` An \eqn{n \times 1}{n x 1} vector of residuals from a +#' linear regression. +#' @param Z `[matrix]` An \eqn{n \times k}{n x k} matrix of instruments. +#' @param X `[matrix]` An \eqn{n \times k}{n x k} matrix of covariates. +#' @param ids `[factor]` A factor of length \eqn{n}, or something that can be +#' coerced into one, that groups observations in `u`. By default each +#' observation belongs to its own group. +#' @param df `[numeric(1) > 0]` An optional degrees of freedom correction. +#' Default is Stata's small sample degrees of freedom correction. #' #' @returns #' A \eqn{k \times k}{k x k} covariance matrix. @@ -68,9 +65,6 @@ sss <- function(n, k, g) { #' vcov2 <- vcovHC(mdl, type = "sss", cluster = "group") #' vcov - vcov2 #' } -#' -#' @export rs_var -#' @importMethodsFrom Matrix solve crossprod tcrossprod rs_var <- function(u, Z, X = Z, ids = seq_len(nrow(X)), df = NULL) { ids <- as.factor(ids) df <- if (is.null(df)) { @@ -89,3 +83,9 @@ rs_var <- function(u, Z, X = Z, ids = seq_len(nrow(X)), df = NULL) { vcov <- tcrossprod(B %*% V, B) df * vcov } + +#' Stata's degrees-of-freedom correction (internal) +#' @noRd +sss <- function(n, k, g) { + g / (g - 1L) * (n - 1L) / (n - k) +} diff --git a/README.Rmd b/README.Rmd index 9d61d20..f40d633 100644 --- a/README.Rmd +++ b/README.Rmd @@ -1,11 +1,8 @@ ---- -output: github_document ---- - -```{r setup, include=FALSE} -knitr::opts_chunk$set(echo = TRUE) +```{r} +#| echo: false +litedown::reactor(print = NA) ``` # Matrices for repeat-sales price indexes rsmatrix website diff --git a/cran-comments.md b/cran-comments.md index 74cfdf7..d719c0b 100644 --- a/cran-comments.md +++ b/cran-comments.md @@ -1,7 +1,8 @@ ## Test environments -- local Ubuntu 24.04 installation, R 4.5.3 +- local Ubuntu 24.04 installation, R 4.6.1 - win-builder (devel, release, oldrelease) +- mac-builder (release) ## R CMD check results diff --git a/inst/CITATION b/inst/CITATION index f0931a4..c776371 100644 --- a/inst/CITATION +++ b/inst/CITATION @@ -1,3 +1,5 @@ +citHeader("To cite rsmatrix in publications use:") + bibentry( bibtype = "Manual", title = "{rsmatrix}: Matrices for Repeat-Sales Price Indexes", diff --git a/inst/WORDLIST b/inst/WORDLIST new file mode 100644 index 0000000..5ce12a2 --- /dev/null +++ b/inst/WORDLIST @@ -0,0 +1,27 @@ +ARS +CMD +Econometricians +Eurostat +GRS +HPI +ILO +LazyData +Manski +McGregor +McSpatial +Muth +Nourse +ORCID +RPPI +RPPIs +Shiller +Shiller's +Stata's +Teranet +codecov +doi +gpindex +hpiR +piar +plm +rsi diff --git a/tests/testthat/test-rs_matrix.R b/inst/tinytest/test-rs_matrix.R similarity index 84% rename from tests/testthat/test-rs_matrix.R rename to inst/tinytest/test-rs_matrix.R index 410cfef..45a3295 100644 --- a/tests/testthat/test-rs_matrix.R +++ b/inst/tinytest/test-rs_matrix.R @@ -1,3 +1,5 @@ +library(rsmatrix) +library(Matrix) # data for computations x <- data.frame( date = c(3, 2, 3, 2, 3, 3), @@ -33,7 +35,8 @@ gg <- solve(crossprod(matg("Z"), matg("X")), crossprod(matg("Z"), matg("Y"))) ga <- solve(crossprod(mata("Z"), mata("X")), crossprod(mata("Z"), mata("Y"))) gb <- solve(crossprod(matb("Z"), matb("X")), crossprod(matb("Z"), matb("Y"))) -test_that("corner cases work", { +# Corner cases work. +local({ m <- rs_matrix( integer(0), character(0), @@ -60,7 +63,8 @@ test_that("corner cases work", { expect_identical(ms("y"), double(0)) }) -test_that("matrices are correct for a simple grouped case", { +# Matrices are correct for a simple grouped case. +local({ m <- rs_matrix( c(2, 3, 2, 2, 4), c(1, 1, 1, 1, 3), @@ -181,7 +185,8 @@ test_that("matrices are correct for a simple grouped case", { ) }) -test_that("matrices are correct for a simple case", { +# Matrices are correct for a simple case. +local({ m <- rs_matrix(c(2, 4), 1:2, c(2, 5), 1:2) expect_identical( m("X"), @@ -201,39 +206,40 @@ test_that("matrices are correct for a simple case", { expect_identical(ms("y"), c("1" = log(2), "2" = log(5 / 2))) }) -test_that("Z matrix works correctly", { +# Z matrix works correctly. +local({ expect_identical( - rsmatrix:::rs_z_(integer(0), character(0)), + rsmatrix:::.rs_z(integer(0), character(0)), matrix(numeric(0), ncol = 0) ) expect_identical( - rsmatrix:::rs_z_(integer(0), character(0), logical(0)), + rsmatrix:::.rs_z(integer(0), character(0), logical(0)), matrix(numeric(0), ncol = 0) ) expect_identical( - suppressWarnings(rsmatrix:::rs_z_(rep("a", 2), rep("a", 2))), + suppressWarnings(rsmatrix:::.rs_z(rep("a", 2), rep("a", 2))), matrix(0, ncol = 1, nrow = 2, dimnames = list(1:2, "a")) ) expect_identical( suppressWarnings( - rsmatrix:::rs_z_(c(a = rep("a", 2)), c(b = rep("a", 2)), 1:2) + rsmatrix:::.rs_z(c(a = rep("a", 2)), c(b = rep("a", 2)), 1:2) ), matrix(rep(0, 4), ncol = 2, dimnames = list(c("a1", "a2"), c("1.a", "2.a"))) ) expect_identical( - suppressWarnings(rsmatrix:::rs_z_(c(a = 2:1), 2:1)), + suppressWarnings(rsmatrix:::.rs_z(c(a = 2:1), 2:1)), matrix(c(0, 0, 0, 0), ncol = 2, dimnames = list(c("a1", "a2"), 1:2)) ) expect_identical( - suppressWarnings(rsmatrix:::rs_z_(1:2, c(a = 2:1))), + suppressWarnings(rsmatrix:::.rs_z(1:2, c(a = 2:1))), matrix(c(1, -1, -1, 1), ncol = 2, dimnames = list(c("a1", "a2"), 1:2)) ) expect_identical( - rsmatrix:::rs_z_(3:2, 2:1), + rsmatrix:::.rs_z(3:2, 2:1), matrix(c(0, -1, -1, 1, 1, 0), ncol = 3, dimnames = list(1:2, 1:3)) ) expect_identical( - rsmatrix:::rs_z_(c(a = 2, b = 2), c(1, 1), c("a", "b")), + rsmatrix:::.rs_z(c(a = 2, b = 2), c(1, 1), c("a", "b")), matrix( c(-1, 0, 0, -1, 1, 0, 0, 1), ncol = 4, @@ -241,7 +247,7 @@ test_that("Z matrix works correctly", { ) ) expect_identical( - rsmatrix:::rs_z_(factor(c(3:2, 2)), c(2:1, 1), letters[c(1, 1, 2)]), + rsmatrix:::.rs_z(factor(c(3:2, 2)), c(2:1, 1), letters[c(1, 1, 2)]), matrix( c(0, -1, 0, 0, 0, -1, -1, 1, 0, 0, 0, 1, 1, 0, 0, 0, 0, 0), ncol = 6, @@ -249,22 +255,22 @@ test_that("Z matrix works correctly", { ) ) expect_identical( - rsmatrix:::rs_z_(factor(3:2), 2:1), - rsmatrix:::rs_z_(3:2, 2:1) + rsmatrix:::.rs_z(factor(3:2), 2:1), + rsmatrix:::.rs_z(3:2, 2:1) ) expect_identical( suppressWarnings( - rsmatrix:::rs_z_(factor(2:1, levels = 1:3), factor(c(a = 1, b = 1))) + rsmatrix:::.rs_z(factor(2:1, levels = 1:3), factor(c(a = 1, b = 1))) ), matrix(c(-1, 0, 1, 0), ncol = 2, dimnames = list(c("a", "b"), 1:2)) ) expect_identical( - rsmatrix:::rs_z_(factor(letters[3:2]), factor(letters[2:1])), - rsmatrix:::rs_z_(letters[3:2], letters[2:1]) + rsmatrix:::.rs_z(factor(letters[3:2]), factor(letters[2:1])), + rsmatrix:::.rs_z(letters[3:2], letters[2:1]) ) expect_identical( suppressWarnings( - rsmatrix:::rs_z_( + rsmatrix:::.rs_z( as.Date(c("2017-02-01", "2017-03-01", "2017-01-01")), as.Date(c("2017-01-01", "2017-02-01", "2017-01-01")) ) @@ -277,13 +283,14 @@ test_that("Z matrix works correctly", { ) }) -test_that("sparse matrices work correctly", { +# Sparse matrices work correctly. +local({ expect_identical( - rsmatrix:::rs_z_(integer(0), integer(0), sparse = TRUE), + rsmatrix:::.rs_z(integer(0), integer(0), sparse = TRUE), Matrix::sparseMatrix(numeric(0), numeric(0), x = 0) ) expect_identical( - suppressWarnings(rsmatrix:::rs_z_(1, 1, sparse = TRUE)), + suppressWarnings(rsmatrix:::.rs_z(1, 1, sparse = TRUE)), Matrix::sparseMatrix( numeric(0), numeric(0), @@ -293,7 +300,7 @@ test_that("sparse matrices work correctly", { ) ) expect_identical( - suppressWarnings(rsmatrix:::rs_z_(c(a = "a"), "a", sparse = TRUE)), + suppressWarnings(rsmatrix:::.rs_z(c(a = "a"), "a", sparse = TRUE)), Matrix::sparseMatrix( numeric(0), numeric(0), @@ -303,7 +310,7 @@ test_that("sparse matrices work correctly", { ) ) expect_identical( - rsmatrix:::rs_z_(c(2, 2), c(1, 1), c("a", "b"), TRUE), + rsmatrix:::.rs_z(c(2, 2), c(1, 1), c("a", "b"), TRUE), Matrix::sparseMatrix( c(1, 2, 1, 2), 1:4, @@ -312,7 +319,7 @@ test_that("sparse matrices work correctly", { ) ) expect_identical( - suppressWarnings(rsmatrix:::rs_z_(2:1, c(1, 1), sparse = TRUE)), + suppressWarnings(rsmatrix:::.rs_z(2:1, c(1, 1), sparse = TRUE)), Matrix::sparseMatrix( c(1, 1), c(1, 2), @@ -323,14 +330,16 @@ test_that("sparse matrices work correctly", { ) }) -test_that("grouped indexes work", { +# Grouped indexes work. +local({ expect_equal(as.numeric(ba[, 1]), as.numeric(bg[seq(1, 4, 2), 1])) expect_equal(as.numeric(ga[, 1]), as.numeric(gg[seq(1, 4, 2), 1])) expect_equal(as.numeric(bb[, 1]), as.numeric(bg[seq(2, 4, 2), 1])) expect_equal(as.numeric(gb[, 1]), as.numeric(gg[seq(2, 4, 2), 1])) }) -test_that("index calculation agrees with regressions", { +# Index calculation agrees with regressions. +local({ # results from lm expect_equal(as.numeric(b), c(1.306078088475809, 0.943826746689325)) # results from vcovHC @@ -372,7 +381,8 @@ test_that("index calculation agrees with regressions", { ) }) -test_that("errors work", { +# Errors work. +local({ expect_error(rs_matrix(1:4, 1:3, 1:4, 1:4)) expect_error(rs_matrix(1:4, 1:4, 1:4, 1:4, 1:5)) expect_error(rs_matrix(c(1:3, NA), 1:4, 1:4, 1:4)) diff --git a/tests/testthat/test-rs_pairs.R b/inst/tinytest/test-rs_pairs.R similarity index 80% rename from tests/testthat/test-rs_pairs.R rename to inst/tinytest/test-rs_pairs.R index 3833fba..c8c08d1 100644 --- a/tests/testthat/test-rs_pairs.R +++ b/inst/tinytest/test-rs_pairs.R @@ -1,18 +1,17 @@ -test_that("an easy example works", { - # An easy-to-verify test - # y x x_prev pos - # b 1 1 1 - # c 10 7 10 - # a 1 1 3 - # a 2 1 3 - # a 3 2 4 - # b 3 2 7 - # b 2 1 1 - # d 1 1 8 - # c 11 10 2 - # c 7 7 10 - # d 1 1 8 - +# An easy-to-verify test +# y x x_prev pos +# b 1 1 1 +# c 10 7 10 +# a 1 1 3 +# a 2 1 3 +# a 3 2 4 +# b 3 2 7 +# b 2 1 1 +# d 1 1 8 +# c 11 10 2 +# c 7 7 10 +# d 1 1 8 +local({ x <- c(1, 10, 1:3, 3:2, 1, 11, 7, 1) y <- factor(letters[c(2, 3, 1, 1, 1, 2, 2, 4, 3, 3, 4)]) @@ -45,7 +44,8 @@ test_that("an easy example works", { ) }) -test_that("a more complex example works", { +# A more complex example works. +local({ x <- c( "3", "15", @@ -70,7 +70,8 @@ test_that("a more complex example works", { ) }) -test_that("corner cases work", { +# Corner cases work. +local({ expect_identical(rs_pairs(numeric(0), character(0)), integer(0)) expect_identical( rs_pairs(numeric(0), character(0), match_first = FALSE), @@ -85,7 +86,8 @@ test_that("corner cases work", { expect_identical(rs_pairs(c(1, 2, 3, 2), rep(1, 4)), c(1L, 1L, 4L, 2L)) }) -test_that("sales pairs are back periods", { +# Sales pairs are back periods. +local({ period <- c(3, 3, 4, 2, 2, 1, 4, 1, 1, 3, 2, 4) product <- c(1, 3, 2, 3, 2, 1, 1, 2, 3, 2, 1, 3) expect_equal( @@ -99,6 +101,7 @@ test_that("sales pairs are back periods", { ) }) -test_that("different length inputs is an error", { +# Different length inputs is an error. +local({ expect_error(rs_pairs(1:3, 1:2)) }) diff --git a/man/rs_matrix.Rd b/man/rs_matrix.Rd index 8057842..a32dd60 100644 --- a/man/rs_matrix.Rd +++ b/man/rs_matrix.Rd @@ -7,19 +7,21 @@ rs_matrix(t2, t1, p2, p1, f = NULL, sparse = FALSE) } \arguments{ -\item{t2, t1}{A pair of vectors giving the time period of the second and +\item{t2, t1}{\verb{[Date | character]} A pair of vectors giving the time period of +the second and first sale, respectively. Usually a vector of dates, but other values are possible if they can be coerced to character vectors and sorted in chronological order (i.e., with \code{\link[=order]{order()}}).} -\item{p2, p1}{A pair of numeric vectors giving the price of the second and -first sale, respectively.} +\item{p2, p1}{\verb{[numeric > 0]} A pair of numeric vectors giving the price of +the second and first sale, respectively.} -\item{f}{An optional factor the same length as \code{t1} and \code{t2}, or a +\item{f}{\verb{[factor]} An optional factor the same length as \code{t1} and \code{t2}, or a vector to be turned into a factor, that is used to group sales.} -\item{sparse}{Should sparse matrices from the \pkg{Matrix} package be used -(faster for large datasets), or regular dense matrices (the default)?} +\item{sparse}{\verb{[logical(1)]} Should sparse matrices from the \pkg{Matrix} +package be used (faster for large datasets), or regular dense matrices +(the default)?} } \value{ A function that takes a single argument naming the desired matrix. @@ -89,7 +91,6 @@ x <- data.frame( mat <- with(x, rs_matrix(date, date_prev, price, price_prev, group)) b <- solve(crossprod(mat("Z"), mat("X")), crossprod(mat("Z"), mat("Y")))[, 1] 100 / b - } \references{ Bailey, M. J., Muth, R. F., and Nourse, H. O. (1963). A regression method diff --git a/man/rs_pairs.Rd b/man/rs_pairs.Rd index 09c42ff..f100816 100644 --- a/man/rs_pairs.Rd +++ b/man/rs_pairs.Rd @@ -7,16 +7,17 @@ rs_pairs(period, product, match_first = TRUE) } \arguments{ -\item{period}{A vector that gives the time period for each sale. Usually a +\item{period}{\verb{[Date | factor]} A vector that gives the time period for each +sale. Usually a date vector, or a factor with the levels in chronological order, but other values are possible if they can be sorted in chronological order (i.e., with \code{\link[=order]{order()}}).} -\item{product}{A vector that gives the product identifier for each sale. -Usually a factor or vector of integer codes for each product.} +\item{product}{\verb{[factor]} A vector that gives the product identifier for each +sale. Usually a factor or vector of integer codes for each product.} -\item{match_first}{Should products in the first period match with -themselves (the default)?} +\item{match_first}{\verb{[logical(1)]} Should products in the first period match +with themselves (the default)?} } \value{ A numeric vector of indices giving the position of the previous sale @@ -46,7 +47,6 @@ pairs <- rs_pairs(x$date, x$id) x[c("date_prev", "price_prev")] <- x[c("date", "price")][pairs, ] x - } \seealso{ \code{\link[=rs_matrix]{rs_matrix()}} for using sales pairs to make a repeat-sales index. diff --git a/man/rs_var.Rd b/man/rs_var.Rd index 7022745..570aa11 100644 --- a/man/rs_var.Rd +++ b/man/rs_var.Rd @@ -7,19 +7,19 @@ rs_var(u, Z, X = Z, ids = seq_len(nrow(X)), df = NULL) } \arguments{ -\item{u}{An \eqn{n \times 1}{n x 1} vector of residuals from a linear -regression.} +\item{u}{\verb{[numeric]} An \eqn{n \times 1}{n x 1} vector of residuals from a +linear regression.} -\item{Z}{An \eqn{n \times k}{n x k} matrix of instruments.} +\item{Z}{\verb{[matrix]} An \eqn{n \times k}{n x k} matrix of instruments.} -\item{X}{An \eqn{n \times k}{n x k} matrix of covariates.} +\item{X}{\verb{[matrix]} An \eqn{n \times k}{n x k} matrix of covariates.} -\item{ids}{A factor of length \eqn{n}, or something that can be coerced into -one, that groups observations in \code{u}. By default each observation -belongs to its own group.} +\item{ids}{\verb{[factor]} A factor of length \eqn{n}, or something that can be +coerced into one, that groups observations in \code{u}. By default each +observation belongs to its own group.} -\item{df}{An optional degrees of freedom correction. Default is Stata's -small sample degrees of freedom correction.} +\item{df}{\verb{[numeric(1) > 0]} An optional degrees of freedom correction. +Default is Stata's small sample degrees of freedom correction.} } \value{ A \eqn{k \times k}{k x k} covariance matrix. @@ -38,7 +38,7 @@ when a regression is calculated by hand. This generalizes the variance matrix proposed by Shiller (1991, section II) when a property sells more than twice. -This function gives the same result as \code{vcovHC(x, type = 'sss', cluster = 'group')} from the \pkg{plm} package. +This function gives the same result as \code{vcovHC(x, type = "sss", cluster = 'group')} from the \pkg{plm} package. } \examples{ # Makes some groups in mtcars @@ -64,7 +64,6 @@ mdl <- plm(mpg ~ cyl + disp, mtcars, model = "pooling", index = "clust") vcov2 <- vcovHC(mdl, type = "sss", cluster = "group") vcov - vcov2 } - } \references{ Manski, C. (1988). \emph{Analog Estimation Methods in Econometrics}. diff --git a/tests/Examples/rsmatrix-Ex.Rout.save b/tests/Examples/rsmatrix-Ex.Rout.save index 7d3f346..56fc280 100644 --- a/tests/Examples/rsmatrix-Ex.Rout.save +++ b/tests/Examples/rsmatrix-Ex.Rout.save @@ -94,7 +94,6 @@ Type 'q()' to quit R. > > > -> > cleanEx() > nameEx("rs_pairs") > ### * rs_pairs @@ -131,7 +130,6 @@ Type 'q()' to quit R. > > > -> > cleanEx() > nameEx("rs_var") > ### * rs_var @@ -170,7 +168,6 @@ Type 'q()' to quit R. > > > -> > ### *