extend-contract.R 2.54 KB
Newer Older
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 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112
# 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)])