R Under development (unstable) (2024-08-23 r87049 ucrt) -- "Unsuffered Consequences"
Copyright (C) 2024 The R Foundation for Statistical Computing
Platform: x86_64-w64-mingw32/x64

R is free software and comes with ABSOLUTELY NO WARRANTY.
You are welcome to redistribute it under certain conditions.
Type 'license()' or 'licence()' for distribution details.

R is a collaborative project with many contributors.
Type 'contributors()' for more information and
'citation()' on how to cite R or R packages in publications.

Type 'demo()' for some demos, 'help()' for on-line help, or
'help.start()' for an HTML browser interface to help.
Type 'q()' to quit R.

> ################################################################################
> ##
> ## $Id: portfolio.matching.test.R 389 2007-01-10 04:28:44Z enos $
> ##
> ## 
> ##
> ################################################################################
> 
> library(portfolio)
Loading required package: grid
Loading required package: lattice
> 
> load("portfolio.matching.test.RData")
> ## save(p, p.truth, file = "portfolio.matching.test.RData", compress = TRUE)
> 
> p.m <- matching(p, covariates = c("country", "sector", "liquidity"))
Warning message:
glm.fit: fitted probabilities numerically 0 or 1 occurred 
> p.test <- portfolio:::.match.as.portfolioBasic(p.m, 1)
> 
> stopifnot(
+           validObject(p.m),
+           all.equal(p.test, p.truth)
+           )
> 
> ## basic test of "sample" method
> 
> p.m <- matching(p, covariates = c("sector", "liquidity"), method = "sample",
+                 n.matches = 5)
> 
> 
> stopifnot(
+           all.equal(dim(p.m@matches), c(33, 5))
+           )
> 
> set.seed(1)
> 
> p.m <- matching(p, method = "random", n.matches = 5)
> 
> 
> stopifnot(
+           all.equal(dim(p.m@matches), c(33, 5))
+           )
> 
> ################################################################################
> ## Subroutine tests 
> ################################################################################
> 
> ## .matching.prep
> 
> #test <- portfolio:::.matching.prep(data = p@data, weights = p@weights,
> #                       covariates = c("sector", "liquidity"))
> 
> #stopifnot(
> #          all(test[test$treatment, "id"] %in% p@weights$id)
> #          )
> 
> ## .matching.scaled.weights
> 
> id.map <- matrix(nrow = 31,
+                  ncol = 1,
+                  dimnames = list(p@weights$id[-(1:2)], 1)
+                  )
> 
> 
> test <- portfolio:::.matching.scale.weights(weights = p@weights, id.map = id.map)
> 
> stopifnot(
+           all.equal(test$weight, rep(-0.032, length(test$weight)),
+                     tolerance = 0.01)
+           )
> 
> ## tests the "calc.scaling.factor.R" function
> 
> orig.weights <- rep(c(0.2, -0.2), length.out = 10)
> matched.weights <- rep(c(0.1, -0.1), length.out = 10)
> 
> test  <- portfolio:::.calc.scaling.factor(orig.weights, matched.weights)
> truth <- c(2,2)
> names(truth) <- c("-1", "1")
> 
> stopifnot(
+           all.equal(test, truth)
+           )
> 
> ## tests the ".scale.weights" function
> 
> ## long-only portfolio
> 
> scaling.factors <- 5
> names(scaling.factors) <-  "1"
> 
> x <- rep(0.04, length.out = 5)
> 
> scaled.x <- portfolio:::.scale.weights(x, scaling.factors)
> 
> stopifnot(
+           all.equal(sum(scaled.x), 1)
+           )
> 
> ## short-only portfolio
> 
> scaling.factors <- 5
> names(scaling.factors) <-  "-1"
> 
> x <- rep(-0.04, length.out = 5)
> 
> scaled.x <- portfolio:::.scale.weights(x, scaling.factors)
> 
> stopifnot(
+           all.equal(sum(scaled.x), -1)
+           )
> 
> ## long-short portfolio
> 
> scaling.factors <- c(5,5)
> names(scaling.factors) <- c("-1", "1")
> 
> x <- rep(c(-0.04, 0.04), length.out = 10)
> 
> scaled.x <- portfolio:::.scale.weights(x, scaling.factors)
> 
> stopifnot(
+           all.equal(sum(scaled.x), 0)
+           )
> 
> ## corner case where original portfolio is long-short and matched
> ## portfolio is long or short only
> 
> scaling.factors <- c(2,2)
> names(scaling.factors) <- c("-1", "1")
> 
> x <- rep(0.1, length.out = 5)
> 
> scaled.x <- portfolio:::.scale.weights(x, scaling.factors)
> 
> stopifnot(
+           all.equal(sum(scaled.x), 1)
+           )
> 
> proc.time()
   user  system elapsed 
   0.87    0.21    1.07