The R Project SVN – R – Diff – /trunk/tests/reg-tests-1b.R



n <- 12; p <- 3
set.seed(46)
d <- dist(matrix(round(rnorm(n*p), digits = 2), n,p), "manhattan")
d[] <- d[] * sample(1 + (-4:4)/100, length(d), replace=TRUE)
hc <- hclust(d, method = "median")
print(hc$height[5:11], digits=10)
stopifnot(all.equal(hc$height[5:11],
		    c(1.70595, 1.657675, 1.8909, 1.619973438,
                      1.548624609, 3.097474902, 6.097159351),
                    tolerance = 1e-9))
## Also ensure that hclust() remains fast:
set.seed(1); nn <- 2000
(tm0<- system.time(dst <- as.dist(matrix(runif(n = nn^2, min = 0, max = 1)^1.1, nn, nn))))
(tm <- system.time(hc <- hclust(dst, method="average")))
if(Sys.getenv("_R_CHECK_DO_R_TIMING_", FALSE)) # typically, factor of ~ 1/3
    stopifnot(tm[1] <= tm0[1]) else stopifnot(tm[1] <= 2*tm0[1]) 
## was slow  from R 1.9.0 up to R 2.15.0
 
 
## 'infinity' partially matched 'inf'
stopifnot(as.numeric("infinity") == Inf)

The R Project SVN R

(root)/trunk/tests/reg-tests-1b.R @ 77458 – Rev 88200 → 89853

Rev 88200		Rev 89853
Line 1822...		Line 1822...
1822	`n <- 12; p <- 3`	1822	`n <- 12; p <- 3`
1823	`set.seed(46)`	1823	`set.seed(46)`
1824	`d <- dist(matrix(round(rnorm(n*p), digits = 2), n,p), "manhattan")`	1824	`d <- dist(matrix(round(rnorm(n*p), digits = 2), n,p), "manhattan")`
1825	`d[] <- d[] * sample(1 + (-4:4)/100, length(d), replace=TRUE)`	1825	`d[] <- d[] * sample(1 + (-4:4)/100, length(d), replace=TRUE)`
1826	`hc <- hclust(d, method = "median")`	1826	`hc <- hclust(d, method = "median")`
-		1827	`print(hc$height[5:11], digits=10)`
1827	`stopifnot(all.equal(hc$height[5:11],`	1828	`stopifnot(all.equal(hc$height[5:11],`
1828	`c(1.70595, 1.657675, 1.8909, 1.619973438,`	1829	`c(1.70595, 1.657675, 1.8909, 1.619973438,`
1829	`1.548624609, 3.097474902, 6.097159351),`	1830	`1.548624609, 3.097474902, 6.097159351),`
1830	`tolerance = 1e-9))`	1831	`tolerance = 1e-9))`
1831	`## Also ensure that hclust() remains fast:`	1832	`## Also ensure that hclust() remains fast:`
1832	`set.seed(1); nn <- 2000`	1833	`set.seed(1); nn <- 2000`
1833	`tm0 <- system.time(dst <- as.dist(matrix(runif(n = nn^2, min = 0, max = 1)^1.1, nn, nn)))`	1834	`(tm0<- system.time(dst <- as.dist(matrix(runif(n = nn^2, min = 0, max = 1)^1.1, nn, nn))))`
1834	`(tm <- system.time(hc <- hclust(dst, method="average")))`	1835	`(tm <- system.time(hc <- hclust(dst, method="average")))`
-		1836	`if(Sys.getenv("_R_CHECK_DO_R_TIMING_", FALSE)) # typically, factor of ~ 1/3`
1835	`stopifnot(tm[1] <= tm0[1])`	1837	`stopifnot(tm[1] <= tm0[1]) else stopifnot(tm[1] <= 2*tm0[1])`
1836	`## was slow from R 1.9.0 up to R 2.15.0`	1838	`## was slow from R 1.9.0 up to R 2.15.0`
1837		1839
1838		1840
1839	`## 'infinity' partially matched 'inf'`	1841	`## 'infinity' partially matched 'inf'`
1840	`stopifnot(as.numeric("infinity") == Inf)`	1842	`stopifnot(as.numeric("infinity") == Inf)`