Commit 44f3160c authored by Radford Neal's avatar Radford Neal

added extend-contract test

parent da935947
More tests.
tests/extend-contract.R tests vector extension and contractions with
length<-, [, [[, and $.
......@@ -19,6 +19,7 @@ test-src-strict-1 = \
namedcnt.R \
var-lookup.R \
matprod.R \
extend-contract.R \
subsetting.R \
d-p-q-r-tests.R \
parse-deparse.R
......
# Tests of operations that expand and contract vectors, perhaps in place.
#
# Added for pqR, 2017, Radford M. Neal.
# Test expansions/contractions with `length<-`
cat("LENGTH<-\n\n")
show_expansions <- function (v)
{
n <- length(v)
cat("** "); print(v[1:length(v)])
length(v) <- length(v) + 1; cat("** "); print(v[1:length(v)])
length(v) <- length(v) + 1; cat("** "); print(v[1:length(v)])
length(v) <- 2*length(v); cat("** "); print(v[1:length(v)])
length(v) <- length(v)+5; cat("** "); print(v[1:length(v)])
length(v) <- 12345; cat("-- "); print(c(v[1:3],v[12343:12345]))
length(v) <- n+1; cat("** "); print(v[1:length(v)])
length(v) <- n; cat("** "); print(v[1:length(v)])
length(v) <- n-1; cat("** "); print(v[1:length(v)])
length(v) <- 1; cat("** "); print(v[1:length(v)])
length(v) <- 2; cat("** "); print(v[1:length(v)])
}
cat("\nRaw with attribute:\n\n")
r <- as.raw(c(9,3,1,5))
attr(r,"fred") <- 999
show_expansions (r)
cat("\nLogical:\n\n")
show_expansions (c(TRUE,FALSE,TRUE,TRUE,FALSE))
cat("\nInteger:\n\n")
show_expansions (1:7)
cat("\nReal:\n\n")
show_expansions (c(3,9,1))
cat("\nReal with names:\n\n")
show_expansions (c(abc=3,def=9,xyz=1))
cat("\nComplex:\n\n")
show_expansions (c(3+1i,8+9i))
cat("\nString:\n\n")
show_expansions (paste0("a",1:5))
cat("\nList:\n\n")
show_expansions (list (a=9, b=TRUE, c="fred"))
#cat("\nPairlist:\n\n")
#show_expansions (pairlist (a=9, b=TRUE, c="fred"))
# Test expansions/contractions with `[[<-` and `$<-`
cat("\n[[<- and $<-\n\n")
L <- list(a=9,b=8,c=7,d=6,e=5,f=4)
L[[2]] <- NULL
print(L[1:length(L)])
L[["d"]] <- NULL
print(L[1:length(L)])
L[["y"]] <- 99
print(L[1:length(L)])
L$z <- 100
print(L[1:length(L)])
L$e <- NULL
print(L[1:length(L)])
L[[10]] <- 88
print(L[1:length(L)])
cat("\n****\n")
L <- list(a=9,b=8,c=7,d=6,e=5,f=4)
L[2:4] <- NULL
print(L[1:length(L)])
L <- list(a=9,b=8,c=7,d=6,e=5,f=4)
L[c(3L,4L)] <- NULL
print(L[1:length(L)])
L <- list(a=9,b=8,c=7,d=6,e=5,f=4)
n <- names(L)
L[2:4] <- NULL
print(L[1:length(L)])
cat("\n****\n")
L <- list(a=9,b=8,c=7,d=6,e=5,f=4)
n <- names(L)
L[[3]] <- NULL
print(L[1:length(L)])
print(n)
cat("\n****\n")
M <- matrix(list(1,TRUE,"a",3i),2,2)
M[[2]] <- NULL
print(M)
M <- matrix(list(1,TRUE,"a",3i),2,2)
M[[5]] <- "x"
print(length(M))
print(M)
# Test expansions/contractions with `[<-`
cat("\n****\n")
v <- c(a=8,b=9,c=1,d=3)
print(v[1:length(v)])
v[8] <- 7
print(v[1:length(v)])
v[4:11] <- 6
print(v[1:length(v)])
v[14] <- c(x=99)
print(v[1:length(v)])
pqR version 2.15.1 (2017-00-00), based on R 2.15.0 (2012-03-30)
R 2.15.0 is Copyright (C) 2012 The R Foundation for Statistical Computing
ISBN 3-900051-07-0
Modifications to R in pqR are Copyright (C) 2013-2017 Radford M. Neal
Some modules are from R-2.15.1 or later versions distributed by the R Core Team
Platform: x86_64-unknown-linux-gnu (64-bit)
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.
No helper threads, task merging enabled, uncompressed pointers.
> # Tests of operations that expand and contract vectors, perhaps in place.
> #
> # Added for pqR, 2017, Radford M. Neal.
>
>
> # Test expansions/contractions with `length<-`
>
> cat("LENGTH<-\n\n")
LENGTH<-
>
> show_expansions <- function (v)
+ {
+ n <- length(v)
+ cat("** "); print(v[1:length(v)])
+ length(v) <- length(v) + 1; cat("** "); print(v[1:length(v)])
+ length(v) <- length(v) + 1; cat("** "); print(v[1:length(v)])
+ length(v) <- 2*length(v); cat("** "); print(v[1:length(v)])
+ length(v) <- length(v)+5; cat("** "); print(v[1:length(v)])
+ length(v) <- 12345; cat("-- "); print(c(v[1:3],v[12343:12345]))
+ length(v) <- n+1; cat("** "); print(v[1:length(v)])
+ length(v) <- n; cat("** "); print(v[1:length(v)])
+ length(v) <- n-1; cat("** "); print(v[1:length(v)])
+ length(v) <- 1; cat("** "); print(v[1:length(v)])
+ length(v) <- 2; cat("** "); print(v[1:length(v)])
+ }
>
> cat("\nRaw with attribute:\n\n")
Raw with attribute:
> r <- as.raw(c(9,3,1,5))
> attr(r,"fred") <- 999
> show_expansions (r)
** [1] 09 03 01 05
** [1] 09 03 01 05 00
** [1] 09 03 01 05 00 00
** [1] 09 03 01 05 00 00 00 00 00 00 00 00
** [1] 09 03 01 05 00 00 00 00 00 00 00 00 00 00 00 00 00
-- [1] 09 03 01 00 00 00
** [1] 09 03 01 05 00
** [1] 09 03 01 05
** [1] 09 03 01
** [1] 09
** [1] 09 00
>
> cat("\nLogical:\n\n")
Logical:
> show_expansions (c(TRUE,FALSE,TRUE,TRUE,FALSE))
** [1] TRUE FALSE TRUE TRUE FALSE
** [1] TRUE FALSE TRUE TRUE FALSE NA
** [1] TRUE FALSE TRUE TRUE FALSE NA NA
** [1] TRUE FALSE TRUE TRUE FALSE NA NA NA NA NA NA NA
[13] NA NA
** [1] TRUE FALSE TRUE TRUE FALSE NA NA NA NA NA NA NA
[13] NA NA NA NA NA NA NA
-- [1] TRUE FALSE TRUE NA NA NA
** [1] TRUE FALSE TRUE TRUE FALSE NA
** [1] TRUE FALSE TRUE TRUE FALSE
** [1] TRUE FALSE TRUE TRUE
** [1] TRUE
** [1] TRUE NA
>
> cat("\nInteger:\n\n")
Integer:
> show_expansions (1:7)
** [1] 1 2 3 4 5 6 7
** [1] 1 2 3 4 5 6 7 NA
** [1] 1 2 3 4 5 6 7 NA NA
** [1] 1 2 3 4 5 6 7 NA NA NA NA NA NA NA NA NA NA NA
** [1] 1 2 3 4 5 6 7 NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
-- [1] 1 2 3 NA NA NA
** [1] 1 2 3 4 5 6 7 NA
** [1] 1 2 3 4 5 6 7
** [1] 1 2 3 4 5 6
** [1] 1
** [1] 1 NA
>
> cat("\nReal:\n\n")
Real:
> show_expansions (c(3,9,1))
** [1] 3 9 1
** [1] 3 9 1 NA
** [1] 3 9 1 NA NA
** [1] 3 9 1 NA NA NA NA NA NA NA
** [1] 3 9 1 NA NA NA NA NA NA NA NA NA NA NA NA
-- [1] 3 9 1 NA NA NA
** [1] 3 9 1 NA
** [1] 3 9 1
** [1] 3 9
** [1] 3
** [1] 3 NA
>
> cat("\nReal with names:\n\n")
Real with names:
> show_expansions (c(abc=3,def=9,xyz=1))
** abc def xyz
3 9 1
** abc def xyz
3 9 1 NA
** abc def xyz
3 9 1 NA NA
** abc def xyz
3 9 1 NA NA NA NA NA NA NA
** abc def xyz
3 9 1 NA NA NA NA NA NA NA NA NA NA NA NA
-- abc def xyz
3 9 1 NA NA NA
** abc def xyz
3 9 1 NA
** abc def xyz
3 9 1
** abc def
3 9
** abc
3
** abc
3 NA
>
> cat("\nComplex:\n\n")
Complex:
> show_expansions (c(3+1i,8+9i))
** [1] 3+1i 8+9i
** [1] 3+1i 8+9i NA
** [1] 3+1i 8+9i NA NA
** [1] 3+1i 8+9i NA NA NA NA NA NA
** [1] 3+1i 8+9i NA NA NA NA NA NA NA NA NA NA NA
-- [1] 3+1i 8+9i NA NA NA NA
** [1] 3+1i 8+9i NA
** [1] 3+1i 8+9i
** [1] 3+1i
** [1] 3+1i
** [1] 3+1i NA
>
> cat("\nString:\n\n")
String:
> show_expansions (paste0("a",1:5))
** [1] "a1" "a2" "a3" "a4" "a5"
** [1] "a1" "a2" "a3" "a4" "a5" NA
** [1] "a1" "a2" "a3" "a4" "a5" NA NA
** [1] "a1" "a2" "a3" "a4" "a5" NA NA NA NA NA NA NA NA NA
** [1] "a1" "a2" "a3" "a4" "a5" NA NA NA NA NA NA NA NA NA NA
[16] NA NA NA NA
-- [1] "a1" "a2" "a3" NA NA NA
** [1] "a1" "a2" "a3" "a4" "a5" NA
** [1] "a1" "a2" "a3" "a4" "a5"
** [1] "a1" "a2" "a3" "a4"
** [1] "a1"
** [1] "a1" NA
>
> cat("\nList:\n\n")
List:
> show_expansions (list (a=9, b=TRUE, c="fred"))
** $a
[1] 9
$b
[1] TRUE
$c
[1] "fred"
** $a
[1] 9
$b
[1] TRUE
$c
[1] "fred"
[[4]]
NULL
** $a
[1] 9
$b
[1] TRUE
$c
[1] "fred"
[[4]]
NULL
[[5]]
NULL
** $a
[1] 9
$b
[1] TRUE
$c
[1] "fred"
[[4]]
NULL
[[5]]
NULL
[[6]]
NULL
[[7]]
NULL
[[8]]
NULL
[[9]]
NULL
[[10]]
NULL
** $a
[1] 9
$b
[1] TRUE
$c
[1] "fred"
[[4]]
NULL
[[5]]
NULL
[[6]]
NULL
[[7]]
NULL
[[8]]
NULL
[[9]]
NULL
[[10]]
NULL
[[11]]
NULL
[[12]]
NULL
[[13]]
NULL
[[14]]
NULL
[[15]]
NULL
-- $a
[1] 9
$b
[1] TRUE
$c
[1] "fred"
[[4]]
NULL
[[5]]
NULL
[[6]]
NULL
** $a
[1] 9
$b
[1] TRUE
$c
[1] "fred"
[[4]]
NULL
** $a
[1] 9
$b
[1] TRUE
$c
[1] "fred"
** $a
[1] 9
$b
[1] TRUE
** $a
[1] 9
** $a
[1] 9
[[2]]
NULL
>
> #cat("\nPairlist:\n\n")
> #show_expansions (pairlist (a=9, b=TRUE, c="fred"))
>
>
> # Test expansions/contractions with `[[<-` and `$<-`
>
> cat("\n[[<- and $<-\n\n")
[[<- and $<-
>
> L <- list(a=9,b=8,c=7,d=6,e=5,f=4)
> L[[2]] <- NULL
> print(L[1:length(L)])
$a
[1] 9
$c
[1] 7
$d
[1] 6
$e
[1] 5
$f
[1] 4
> L[["d"]] <- NULL
> print(L[1:length(L)])
$a
[1] 9
$c
[1] 7
$e
[1] 5
$f
[1] 4
> L[["y"]] <- 99
> print(L[1:length(L)])
$a
[1] 9
$c
[1] 7
$e
[1] 5
$f
[1] 4
$y
[1] 99
> L$z <- 100
> print(L[1:length(L)])
$a
[1] 9
$c
[1] 7
$e
[1] 5
$f
[1] 4
$y
[1] 99
$z
[1] 100
> L$e <- NULL
> print(L[1:length(L)])
$a
[1] 9
$c
[1] 7
$f
[1] 4
$y
[1] 99
$z
[1] 100
> L[[10]] <- 88
> print(L[1:length(L)])
$a
[1] 9
$c
[1] 7
$f
[1] 4
$y
[1] 99
$z
[1] 100
[[6]]
NULL
[[7]]
NULL
[[8]]
NULL
[[9]]
NULL
[[10]]
[1] 88
>
> cat("\n****\n")
****
> L <- list(a=9,b=8,c=7,d=6,e=5,f=4)
> L[2:4] <- NULL
> print(L[1:length(L)])
$a
[1] 9
$e
[1] 5
$f
[1] 4
> L <- list(a=9,b=8,c=7,d=6,e=5,f=4)
> L[c(3L,4L)] <- NULL
> print(L[1:length(L)])
$a
[1] 9
$b
[1] 8
$e
[1] 5
$f
[1] 4
> L <- list(a=9,b=8,c=7,d=6,e=5,f=4)
> n <- names(L)
> L[2:4] <- NULL
> print(L[1:length(L)])
$a
[1] 9
$e
[1] 5
$f
[1] 4
>
> cat("\n****\n")
****
> L <- list(a=9,b=8,c=7,d=6,e=5,f=4)
> n <- names(L)
> L[[3]] <- NULL
> print(L[1:length(L)])
$a
[1] 9
$b
[1] 8
$d
[1] 6
$e
[1] 5
$f
[1] 4
> print(n)
[1] "a" "b" "c" "d" "e" "f"
>
> cat("\n****\n")
****
> M <- matrix(list(1,TRUE,"a",3i),2,2)
> M[[2]] <- NULL
> print(M)
[[1]]
[1] 1
[[2]]
[1] "a"
[[3]]
[1] 0+3i
> M <- matrix(list(1,TRUE,"a",3i),2,2)
> M[[5]] <- "x"
> print(length(M))
[1] 5
> print(M)
[[1]]
[1] 1
[[2]]
[1] TRUE
[[3]]
[1] "a"
[[4]]
[1] 0+3i
[[5]]
[1] "x"
>
> # Test expansions/contractions with `[<-`
>
> cat("\n****\n")
****
> v <- c(a=8,b=9,c=1,d=3)
> print(v[1:length(v)])
a b c d
8 9 1 3
> v[8] <- 7
> print(v[1:length(v)])
a b c d
8 9 1 3 NA NA NA 7
> v[4:11] <- 6
> print(v[1:length(v)])
a b c d
8 9 1 6 6 6 6 6 6 6 6
> v[14] <- c(x=99)
> print(v[1:length(v)])
a b c d
8 9 1 6 6 6 6 6 6 6 6 NA NA 99
>
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment