Nothing
tests/testthat/test-transpose.R
In procs: Recreates Some 'SAS®' Procedures in 'R'
base_path <- "c:/packages/procs/tests/testthat"
data_dir <- base_path
base_path <- tempdir()
data_dir <- "."
dev <- FALSE
score <- read.table(header = TRUE,
colClasses = c(Student = "character", StudentID = "character",
Section = "character"), text = '
Student StudentID Section Test1 Test2 Final
Capalleti "0545" "1" 94 91 87
Dubose "1252" "2" 51 65 91
Engles "1167" "1" 95 97 97
Grant "1230" "2" 63 75 80
Krupski "2527" "2" 80 76 71
Lundsford "4860" "1" 92 40 86
McBane "0674" "1" 75 78 72
', stringsAsFactors = FALSE)
dat2 <- read.table(header = TRUE, text ='
ID Location Date Length1 Weight1 Length2 Weight2 Length3 Weight3 Length4 Weight4
1 "Cole Pond" 2JUN95 31 .25 32 .3 32 .25 33 .3
2 "Cole Pond" 3JUL95 33 .32 34 .41 37 .48 32 .28
3 "Cole Pond" 4AUG95 29 .23 30 .25 34 .47 32 .3
4 "Eagle Lake" 2JUN95 32 .35 32 .25 33 .30 NA NA
5 "Eagle Lake" 3JUL95 30 .20 36 .45 NA NA NA NA
6 "Eagle Lake" 4AUG95 33 .30 33 .28 34 .42 NA NA
', stringsAsFactors = FALSE)
datm <- read.table(header = TRUE, text = '
LastName Age PresentScore TasteScore Flavor Layers
Orlando 27 93 80 Vanilla 1
Ramey 32 84 72 Rum 2
Goldston 46 68 75 Vanilla 1
Roe 38 79 73 Vanilla 2
Larsen 23 77 84 Chocolate 3
Davis 51 86 91 Spice 3
Strickland 19 82 79 Chocolate 1
Nguyen 57 77 84 Vanilla 3
Hildenbrand 33 81 83 Chocolate 1
Byron 62 72 87 Vanilla 2
Sanders 26 56 79 Chocolate 1
Jaeger 43 66 74 Rum 1
Davis 28 69 75 Chocolate 2
Conrad 69 85 94 Vanilla 1
Walters 55 67 72 Chocolate 2
Rossburger 28 78 81 Spice 2
Matthew 42 81 92 Chocolate 2
Becker 36 62 83 Spice 2
Anderson 27 87 85 Chocolate 1
Merritt 62 73 84 Chocolate 1
', stringsAsFactors = FALSE)
prt <- read.table(header = TRUE, text = '
sex internship enrollment count
1 boys yes yes 35
2 boys no yes 14
3 girls yes yes 32
4 girls no yes 53
5 boys yes no 29
6 boys no no 27
7 girls yes no 10
8 girls no no 23',
stringsAsFactors = FALSE)
prt2 <- read.table(header = TRUE, text = '
sex internship enrollment count group
1 boys yes yes 35 1
2 boys no yes 14 1
3 girls yes yes 32 1
4 girls no yes 53 1
5 boys yes no 29 2
6 boys no no 27 2
7 girls yes no 10 2
8 girls no no 23 2',
stringsAsFactors = FALSE)
ageg <- read.table(header = TRUE, text = '
VAR LABEL CAT2 N CNTPCT
1 AGECAT "18 to 24" "ARM A" 85 "0 ( 0.0%)"
2 AGECAT "18 to 24" "ARM B" 85 "1 ( 1.2%)"
3 AGECAT "18 to 24" "ARM C" 85 "3 ( 3.5%)"
4 AGECAT "18 to 24" "ARM D" 85 "1 ( 1.2%)"
5 AGECAT "25 to 44" "ARM A" 85 "4 ( 4.7%)"
6 AGECAT "25 to 44" "ARM B" 85 "8 ( 9.4%)"
7 AGECAT "25 to 44" "ARM C" 85 "4 ( 4.7%)"
8 AGECAT "25 to 44" "ARM D" 85 "7 ( 8.2%)"
9 AGECAT "45 to 64" "ARM A" 85 "13 ( 15.3%)"
10 AGECAT "45 to 64" "ARM B" 85 "7 ( 8.2%)"
11 AGECAT "45 to 64" "ARM C" 85 "12 ( 14.1%)"
12 AGECAT "45 to 64" "ARM D" 85 "12 ( 14.1%)"
13 AGECAT ">= 65" "ARM A" 85 "3 ( 3.5%)"
14 AGECAT ">= 65" "ARM B" 85 "5 ( 5.9%)"
15 AGECAT ">= 65" "ARM C" 85 "2 ( 2.4%)"
16 AGECAT ">= 65" "ARM D" 85 "3 ( 3.5%)"',
stringsAsFactors = FALSE)
test_that("transpose1: basic var works without error.", {
res <- proc_transpose(score, var = c("Test1", "Test2", "Final"))
res
expect_equal(nrow(res), 3)
expect_equal(ncol(res), 8)
})
test_that("transpose2: no var works without error.", {
res <- proc_transpose(score)
res
expect_equal(nrow(res), 3)
expect_equal(ncol(res), 8)
})
test_that("transpose3: name parameter works as expected.", {
res <- proc_transpose(score, name = "Test")
res
expect_equal(names(res[1]), "Test")
})
test_that("transpose4: name_label works.", {
res <- proc_transpose(score, namelabel = "Test")
res
expect_equal(names(res[1]), "NAME")
expect_equal(attr(res[[1]], "label"), "Test")
})
test_that("transpose5: id, prefix, and suffix works.", {
res <- proc_transpose(score, id = "StudentID", prefix = "sn", suffix = "x")
res
expect_equal(names(res[2]), "sn0545x")
})
test_that("transpose6: id and idlabel.", {
res <- proc_transpose(score, id = "StudentID", idlabel = "Student")
res
expect_equal(names(res[1]), "NAME")
expect_equal(attr(res[[2]], "label"), "Capalleti")
})
test_that("transpose7: proc_means and proc_transpose.", {
mres <- proc_means(score, var = c("Test1", "Test2", "Final"),
stats = c("n", "mean", "std", "median", "min", "max"),
options = v(out, notype, nonobs))
res <- proc_transpose(mres, id = "VAR", name = "STAT")
res
expect_equal(ncol(res), 4)
expect_equal(nrow(res), 6)
})
test_that("transpose8: transpose by with one variable.", {
res <- proc_transpose(dat2, var =c("Length1", "Length2", "Length3", "Length4")
, by = "Location",
name = "Measure", id = "Date" )
res
expect_equal(ncol(res), 5)
expect_equal(nrow(res), 8)
expect_equal(names(res)[3], "2JUN95")
})
test_that("transpose8: transpose by with one variable and id labels.", {
res <- proc_transpose(dat2, var =c("Length1", "Length2", "Length3", "Length4")
, by = "Location",
name = "Measure", idlabel = "Date" )
res
expect_equal(ncol(res), 5)
expect_equal(nrow(res), 8)
expect_equal(names(res)[3], "COL1")
expect_equal(attr(res[[3]], "label"), "2JUN95")
})
test_that("transpose9: transpose by with two variables.", {
res <- proc_transpose(dat2, var =c("Length1", "Length2", "Length3", "Length4")
, by = c("Location", "Date"),
name = "Measure")
res
expect_equal(nrow(res), 24)
expect_equal(ncol(res), 4)
})
test_that("transpose10: transpose by with two variables and v() function.", {
res <- proc_transpose(dat2, var =v(Length1, Length2, Length3, Length4)
, by = v(Location, Date),
name = "Measure")
res
expect_equal(nrow(res), 24)
expect_equal(ncol(res), 4)
})
test_that("transpose11: copy parameter works recycle bigger.", {
stats <- proc_means(datm, options = v(out,
notype, nonobs))
res1 <- data.frame(Group = "Group1", stats)
res2 <- proc_transpose(res1, copy = "Group",
name = "STAT", id = "VAR")
res2
expect_equal(nrow(res2), 5)
expect_equal(ncol(res2), 6)
expect_equal("Group" %in% names(res2), TRUE)
})
test_that("transpose12: copy parameter works recycle smaller", {
stats <- proc_means(datm, stats = c("n", "mean", "median"),
options = v(out, notype, nonobs))
res1 <- data.frame(Group = "Group1", stats)
res2 <- proc_transpose(res1, copy = "Group",
name = "STAT", id = "VAR")
res2
expect_equal(nrow(res2), 3)
expect_equal(ncol(res2), 6)
expect_equal("Group" %in% names(res2), TRUE)
})
test_that("transpose13: copy parameter works recycle smaller", {
mns <- proc_means(datm, stats = c("n", "mean", "median", "min", "max"),
var = "Age", class = "Flavor",
options = v(notype, nonobs))
mns[1, 1] <- "Total"
mns
res <- proc_transpose(mns, var = c("N", "MEAN", "MEDIAN", "MIN", "MAX"),
copy = "VAR", name = "STAT", id = "CLASS")
res
res <- res[, c("VAR", "STAT", "Chocolate", "Rum", "Spice", "Vanilla", "Total")]
res
expect_equal(nrow(res), 5)
expect_equal(ncol(res), 7)
})
# Is working
test_that("transpose14: copy parameter works with by groups", {
stats <- proc_means(datm, stats = c("n", "mean", "median"),
var = c("Age", "PresentScore", "TasteScore"),
by = "Layers", options = v(out, notype, nonobs))
stats
res1 <- data.frame(Group = "Group1", stats)
res2 <- proc_transpose(res1, copy = "Group", by = "BY",
name = "STAT", id = "VAR")
res2
expect_equal(nrow(res2), 9)
expect_equal(ncol(res2), 6)
expect_equal("Group" %in% names(res2), TRUE)
})
test_that("transpose15: all vars eliminates by, copy, and id from transpose", {
stats <- proc_means(datm, stats = c("n", "mean", "median"),
by = "Layers",
options = v(out, nonobs, notype))
stats
res1 <- data.frame(Group = "Group1", stats)
res2 <- proc_transpose(res1, copy = "Group", by = "BY",
name = "STAT", id = "VAR")
res2
expect_equal(nrow(res2), 9)
expect_equal(ncol(res2), 6)
expect_equal("Group" %in% names(res2), TRUE)
})
test_that("tranpose16: get_output_twoway() works as expected.", {
res2 <- get_output_twoway(prt, "internship", "enrollment", "count", NULL,
FALSE, by = c(by1 = "A", by2 = "B"))
res2
proc_transpose(res2, name = "STAT", id = c("CAT1", "CAT2"),
copy = c("by1", "by2", "VAR1", "VAR2"))
expect_equal(nrow(res2), 4)
expect_equal(ncol(res2), 10)
})
test_that("transpose17: NSE works on transpose", {
stats <- proc_means(datm, stats = v(n, mean, median),
by = Layers,
options = v(out, nonobs, notype))
stats
res1 <- data.frame(Group = "Group1", stats)
res2 <- proc_transpose(res1, copy = Group, by = BY,
name = STAT, id = VAR)
res2
expect_equal(nrow(res2), 9)
expect_equal(ncol(res2), 6)
expect_equal("Group" %in% names(res2), TRUE)
expect_equal(names(res2), c("Group", "BY", "STAT", "Age",
"PresentScore", "TasteScore"))
})
test_that("transpose18: Where clause works as expected.", {
stats <- proc_means(datm, stats = v(n, mean, median),
by = Layers,
options = v(out, nonobs, notype))
stats
res1 <- data.frame(Group = "Group1", stats)
res2 <- proc_transpose(res1, copy = Group, by = BY,
name = STAT, id = VAR,
where = expression(!BY %in% c(2, 3) | STAT != "N"))
res2
expect_equal(nrow(res2), 7)
expect_equal(ncol(res2), 6)
})
test_that("transpose19: Factor with unused level works.", {
ageg2 <- ageg
ageg2$LABEL <- factor(ageg2$LABEL, levels = c("18 to 24", "25 to 44",
"45 to 64", ">= 65",
"Out of range"))
res <- proc_transpose(ageg2,
var = v(N, CNTPCT),
copy = VAR,
id = CAT2,
by = LABEL)
res
expect_equal(nrow(res), 8)
expect_equal(ncol(res), 7)
})
test_that("transpose20: log_transpose() works as expected.", {
res <- log_transpose(mtcars, var = c("mpg", "cyl"),
id = c("n", "mean", "median"),
idlabel = c("n", "mean", "median"),
copy = "count", name = "sam", namelabel = "fork",
where = expression(x == 1),
by = "cyl", outdata = mtcars)
res
expect_equal(length(res), 10)
})
test_that("transpose21: transposing two id variables.", {
sp <- prt2
sp[1, 2] <- "no"
res <- proc_freq(sp,
tables = c("internship"),
titles = "My first Frequency Table",
by = c("sex"),
weight = "count",
options = v(outcum))
res
res1 <- proc_transpose(res, id = c("BY", "CAT"), copy = c("VAR"))
res1
expect_equal(ncol(res1), 6)
expect_equal(nrow(res1), 5)
})
test_that("transpose22: transposing inconsistent categories.", {
sp <- prt2
sp[1, 2] <- "no"
res <- proc_freq(sp,
tables = c("internship"),
titles = "My first Frequency Table",
by = c("sex", "enrollment"),
weight = "count")
res
res1 <- proc_transpose(res, id = c("BY1", "CAT"), copy = c("VAR"),
by = "BY2")
res1
expect_equal(ncol(res1), 7)
expect_equal(nrow(res1), 6)
})
test_that("transpose23: transpose retains original class.", {
library(tibble)
tmp <- as_tibble(prt)
res <- proc_transpose(tmp, by = sex)
res
expect_equal("tbl_df" %in% class(res), TRUE)
})
test_that("transpose24: Transpose with single by var works", {
ageg
res <- proc_transpose(ageg, by = VAR, id = CAT2, var = v(N, CNTPCT))
expect_equal(nrow(res), 2) # And gets no error
})
test_that("transpose25: transpose by retains data type.", {
s2 <- score
s2$Section <- as.integer(s2$Section)
res <- proc_transpose(s2, by = Section)
res
expect_equal(nrow(res), 6)
expect_equal(ncol(res), 6)
expect_equal(typeof(res$Section), "integer")
s2$Section <- as.double(s2$Section)
res <- proc_transpose(s2, by = Section)
res
expect_equal(nrow(res), 6)
expect_equal(ncol(res), 6)
expect_equal(typeof(res$Section), "double")
s2$Section <- ifelse(s2$Section == 1, TRUE, FALSE)
res <- proc_transpose(s2, by = Section)
res
expect_equal(nrow(res), 6)
expect_equal(ncol(res), 6)
expect_equal(typeof(res$Section), "logical")
s2$Section <- ifelse(s2$Section == TRUE, as.Date("2020-01-01"), as.Date("2021-01-01"))
s2$Section <- as.Date(s2$Section, origin = "1970-01-01")
res <- proc_transpose(s2, by = Section)
res
expect_equal(nrow(res), 6)
expect_equal(ncol(res), 6)
expect_equal(typeof(res$Section), "double")
expect_equal(class(res$Section), "Date")
})
test_that("transpose26: prefix, and suffix works with no ID.", {
res <- proc_transpose(score, prefix = "sn", suffix = "x")
res
expect_equal(names(res[2]), "sn1x")
})
test_that("transpose27: noname options works as expected.", {
res <- proc_transpose(score, var = c("Test1", "Test2", "Final"), options = noname)
res
expect_equal(nrow(res), 3)
expect_equal(ncol(res), 7)
expect_equal("NAME" %in% names(res), FALSE)
})
test_that("transpose28: by factor works as expected.", {
s2 <- score
sect <- ifelse(s2$Section == 1, "Fork", "Bork")
s2$Section <- factor(sect, c("Fork", "Bork"))
res <- proc_transpose(s2, by = Section)
res
expect_equal(nrow(res), 6)
expect_equal(ncol(res), 6)
expect_equal(typeof(res$Section), "integer")
expect_equal(class(res$Section), c("factor"))
s2 <- score
sect <- ifelse(s2$Section == 1, "Fork", "Bork")
s2$Section <- factor(sect, c("Fork", "Bork"), ordered = TRUE)
res <- proc_transpose(s2, by = Section)
res
expect_equal(nrow(res), 6)
expect_equal(ncol(res), 6)
expect_equal(typeof(res$Section), "integer")
expect_equal(class(res$Section), c("ordered", "factor"))
})
test_that("transpose29: parameter checks work.", {
expect_error(proc_transpose("bork", var = c("Student")))
expect_error(proc_transpose(score[0, ], var = c("Student")))
expect_error(proc_transpose(score, var = c("fork")))
})
Try the procs package in your browser
Any scripts or data that you put into this service are public.
procs documentation built on May 29, 2024, 2:12 a.m.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
base_path <- "c:/packages/procs/tests/testthat"
data_dir <- base_path
base_path <- tempdir()
data_dir <- "."
dev <- FALSE
score <- read.table(header = TRUE,
colClasses = c(Student = "character", StudentID = "character",
Section = "character"), text = '
Student StudentID Section Test1 Test2 Final
Capalleti "0545" "1" 94 91 87
Dubose "1252" "2" 51 65 91
Engles "1167" "1" 95 97 97
Grant "1230" "2" 63 75 80
Krupski "2527" "2" 80 76 71
Lundsford "4860" "1" 92 40 86
McBane "0674" "1" 75 78 72
', stringsAsFactors = FALSE)
dat2 <- read.table(header = TRUE, text ='
ID Location Date Length1 Weight1 Length2 Weight2 Length3 Weight3 Length4 Weight4
1 "Cole Pond" 2JUN95 31 .25 32 .3 32 .25 33 .3
2 "Cole Pond" 3JUL95 33 .32 34 .41 37 .48 32 .28
3 "Cole Pond" 4AUG95 29 .23 30 .25 34 .47 32 .3
4 "Eagle Lake" 2JUN95 32 .35 32 .25 33 .30 NA NA
5 "Eagle Lake" 3JUL95 30 .20 36 .45 NA NA NA NA
6 "Eagle Lake" 4AUG95 33 .30 33 .28 34 .42 NA NA
', stringsAsFactors = FALSE)
datm <- read.table(header = TRUE, text = '
LastName Age PresentScore TasteScore Flavor Layers
Orlando 27 93 80 Vanilla 1
Ramey 32 84 72 Rum 2
Goldston 46 68 75 Vanilla 1
Roe 38 79 73 Vanilla 2
Larsen 23 77 84 Chocolate 3
Davis 51 86 91 Spice 3
Strickland 19 82 79 Chocolate 1
Nguyen 57 77 84 Vanilla 3
Hildenbrand 33 81 83 Chocolate 1
Byron 62 72 87 Vanilla 2
Sanders 26 56 79 Chocolate 1
Jaeger 43 66 74 Rum 1
Davis 28 69 75 Chocolate 2
Conrad 69 85 94 Vanilla 1
Walters 55 67 72 Chocolate 2
Rossburger 28 78 81 Spice 2
Matthew 42 81 92 Chocolate 2
Becker 36 62 83 Spice 2
Anderson 27 87 85 Chocolate 1
Merritt 62 73 84 Chocolate 1
', stringsAsFactors = FALSE)
prt <- read.table(header = TRUE, text = '
sex internship enrollment count
1 boys yes yes 35
2 boys no yes 14
3 girls yes yes 32
4 girls no yes 53
5 boys yes no 29
6 boys no no 27
7 girls yes no 10
8 girls no no 23',
stringsAsFactors = FALSE)
prt2 <- read.table(header = TRUE, text = '
sex internship enrollment count group
1 boys yes yes 35 1
2 boys no yes 14 1
3 girls yes yes 32 1
4 girls no yes 53 1
5 boys yes no 29 2
6 boys no no 27 2
7 girls yes no 10 2
8 girls no no 23 2',
stringsAsFactors = FALSE)
ageg <- read.table(header = TRUE, text = '
VAR LABEL CAT2 N CNTPCT
1 AGECAT "18 to 24" "ARM A" 85 "0 ( 0.0%)"
2 AGECAT "18 to 24" "ARM B" 85 "1 ( 1.2%)"
3 AGECAT "18 to 24" "ARM C" 85 "3 ( 3.5%)"
4 AGECAT "18 to 24" "ARM D" 85 "1 ( 1.2%)"
5 AGECAT "25 to 44" "ARM A" 85 "4 ( 4.7%)"
6 AGECAT "25 to 44" "ARM B" 85 "8 ( 9.4%)"
7 AGECAT "25 to 44" "ARM C" 85 "4 ( 4.7%)"
8 AGECAT "25 to 44" "ARM D" 85 "7 ( 8.2%)"
9 AGECAT "45 to 64" "ARM A" 85 "13 ( 15.3%)"
10 AGECAT "45 to 64" "ARM B" 85 "7 ( 8.2%)"
11 AGECAT "45 to 64" "ARM C" 85 "12 ( 14.1%)"
12 AGECAT "45 to 64" "ARM D" 85 "12 ( 14.1%)"
13 AGECAT ">= 65" "ARM A" 85 "3 ( 3.5%)"
14 AGECAT ">= 65" "ARM B" 85 "5 ( 5.9%)"
15 AGECAT ">= 65" "ARM C" 85 "2 ( 2.4%)"
16 AGECAT ">= 65" "ARM D" 85 "3 ( 3.5%)"',
stringsAsFactors = FALSE)
test_that("transpose1: basic var works without error.", {
res <- proc_transpose(score, var = c("Test1", "Test2", "Final"))
res
expect_equal(nrow(res), 3)
expect_equal(ncol(res), 8)
})
test_that("transpose2: no var works without error.", {
res <- proc_transpose(score)
res
expect_equal(nrow(res), 3)
expect_equal(ncol(res), 8)
})
test_that("transpose3: name parameter works as expected.", {
res <- proc_transpose(score, name = "Test")
res
expect_equal(names(res[1]), "Test")
})
test_that("transpose4: name_label works.", {
res <- proc_transpose(score, namelabel = "Test")
res
expect_equal(names(res[1]), "NAME")
expect_equal(attr(res[[1]], "label"), "Test")
})
test_that("transpose5: id, prefix, and suffix works.", {
res <- proc_transpose(score, id = "StudentID", prefix = "sn", suffix = "x")
res
expect_equal(names(res[2]), "sn0545x")
})
test_that("transpose6: id and idlabel.", {
res <- proc_transpose(score, id = "StudentID", idlabel = "Student")
res
expect_equal(names(res[1]), "NAME")
expect_equal(attr(res[[2]], "label"), "Capalleti")
})
test_that("transpose7: proc_means and proc_transpose.", {
mres <- proc_means(score, var = c("Test1", "Test2", "Final"),
stats = c("n", "mean", "std", "median", "min", "max"),
options = v(out, notype, nonobs))
res <- proc_transpose(mres, id = "VAR", name = "STAT")
res
expect_equal(ncol(res), 4)
expect_equal(nrow(res), 6)
})
test_that("transpose8: transpose by with one variable.", {
res <- proc_transpose(dat2, var =c("Length1", "Length2", "Length3", "Length4")
, by = "Location",
name = "Measure", id = "Date" )
res
expect_equal(ncol(res), 5)
expect_equal(nrow(res), 8)
expect_equal(names(res)[3], "2JUN95")
})
test_that("transpose8: transpose by with one variable and id labels.", {
res <- proc_transpose(dat2, var =c("Length1", "Length2", "Length3", "Length4")
, by = "Location",
name = "Measure", idlabel = "Date" )
res
expect_equal(ncol(res), 5)
expect_equal(nrow(res), 8)
expect_equal(names(res)[3], "COL1")
expect_equal(attr(res[[3]], "label"), "2JUN95")
})
test_that("transpose9: transpose by with two variables.", {
res <- proc_transpose(dat2, var =c("Length1", "Length2", "Length3", "Length4")
, by = c("Location", "Date"),
name = "Measure")
res
expect_equal(nrow(res), 24)
expect_equal(ncol(res), 4)
})
test_that("transpose10: transpose by with two variables and v() function.", {
res <- proc_transpose(dat2, var =v(Length1, Length2, Length3, Length4)
, by = v(Location, Date),
name = "Measure")
res
expect_equal(nrow(res), 24)
expect_equal(ncol(res), 4)
})
test_that("transpose11: copy parameter works recycle bigger.", {
stats <- proc_means(datm, options = v(out,
notype, nonobs))
res1 <- data.frame(Group = "Group1", stats)
res2 <- proc_transpose(res1, copy = "Group",
name = "STAT", id = "VAR")
res2
expect_equal(nrow(res2), 5)
expect_equal(ncol(res2), 6)
expect_equal("Group" %in% names(res2), TRUE)
})
test_that("transpose12: copy parameter works recycle smaller", {
stats <- proc_means(datm, stats = c("n", "mean", "median"),
options = v(out, notype, nonobs))
res1 <- data.frame(Group = "Group1", stats)
res2 <- proc_transpose(res1, copy = "Group",
name = "STAT", id = "VAR")
res2
expect_equal(nrow(res2), 3)
expect_equal(ncol(res2), 6)
expect_equal("Group" %in% names(res2), TRUE)
})
test_that("transpose13: copy parameter works recycle smaller", {
mns <- proc_means(datm, stats = c("n", "mean", "median", "min", "max"),
var = "Age", class = "Flavor",
options = v(notype, nonobs))
mns[1, 1] <- "Total"
mns
res <- proc_transpose(mns, var = c("N", "MEAN", "MEDIAN", "MIN", "MAX"),
copy = "VAR", name = "STAT", id = "CLASS")
res
res <- res[, c("VAR", "STAT", "Chocolate", "Rum", "Spice", "Vanilla", "Total")]
res
expect_equal(nrow(res), 5)
expect_equal(ncol(res), 7)
})
# Is working
test_that("transpose14: copy parameter works with by groups", {
stats <- proc_means(datm, stats = c("n", "mean", "median"),
var = c("Age", "PresentScore", "TasteScore"),
by = "Layers", options = v(out, notype, nonobs))
stats
res1 <- data.frame(Group = "Group1", stats)
res2 <- proc_transpose(res1, copy = "Group", by = "BY",
name = "STAT", id = "VAR")
res2
expect_equal(nrow(res2), 9)
expect_equal(ncol(res2), 6)
expect_equal("Group" %in% names(res2), TRUE)
})
test_that("transpose15: all vars eliminates by, copy, and id from transpose", {
stats <- proc_means(datm, stats = c("n", "mean", "median"),
by = "Layers",
options = v(out, nonobs, notype))
stats
res1 <- data.frame(Group = "Group1", stats)
res2 <- proc_transpose(res1, copy = "Group", by = "BY",
name = "STAT", id = "VAR")
res2
expect_equal(nrow(res2), 9)
expect_equal(ncol(res2), 6)
expect_equal("Group" %in% names(res2), TRUE)
})
test_that("tranpose16: get_output_twoway() works as expected.", {
res2 <- get_output_twoway(prt, "internship", "enrollment", "count", NULL,
FALSE, by = c(by1 = "A", by2 = "B"))
res2
proc_transpose(res2, name = "STAT", id = c("CAT1", "CAT2"),
copy = c("by1", "by2", "VAR1", "VAR2"))
expect_equal(nrow(res2), 4)
expect_equal(ncol(res2), 10)
})
test_that("transpose17: NSE works on transpose", {
stats <- proc_means(datm, stats = v(n, mean, median),
by = Layers,
options = v(out, nonobs, notype))
stats
res1 <- data.frame(Group = "Group1", stats)
res2 <- proc_transpose(res1, copy = Group, by = BY,
name = STAT, id = VAR)
res2
expect_equal(nrow(res2), 9)
expect_equal(ncol(res2), 6)
expect_equal("Group" %in% names(res2), TRUE)
expect_equal(names(res2), c("Group", "BY", "STAT", "Age",
"PresentScore", "TasteScore"))
})
test_that("transpose18: Where clause works as expected.", {
stats <- proc_means(datm, stats = v(n, mean, median),
by = Layers,
options = v(out, nonobs, notype))
stats
res1 <- data.frame(Group = "Group1", stats)
res2 <- proc_transpose(res1, copy = Group, by = BY,
name = STAT, id = VAR,
where = expression(!BY %in% c(2, 3) | STAT != "N"))
res2
expect_equal(nrow(res2), 7)
expect_equal(ncol(res2), 6)
})
test_that("transpose19: Factor with unused level works.", {
ageg2 <- ageg
ageg2$LABEL <- factor(ageg2$LABEL, levels = c("18 to 24", "25 to 44",
"45 to 64", ">= 65",
"Out of range"))
res <- proc_transpose(ageg2,
var = v(N, CNTPCT),
copy = VAR,
id = CAT2,
by = LABEL)
res
expect_equal(nrow(res), 8)
expect_equal(ncol(res), 7)
})
test_that("transpose20: log_transpose() works as expected.", {
res <- log_transpose(mtcars, var = c("mpg", "cyl"),
id = c("n", "mean", "median"),
idlabel = c("n", "mean", "median"),
copy = "count", name = "sam", namelabel = "fork",
where = expression(x == 1),
by = "cyl", outdata = mtcars)
res
expect_equal(length(res), 10)
})
test_that("transpose21: transposing two id variables.", {
sp <- prt2
sp[1, 2] <- "no"
res <- proc_freq(sp,
tables = c("internship"),
titles = "My first Frequency Table",
by = c("sex"),
weight = "count",
options = v(outcum))
res
res1 <- proc_transpose(res, id = c("BY", "CAT"), copy = c("VAR"))
res1
expect_equal(ncol(res1), 6)
expect_equal(nrow(res1), 5)
})
test_that("transpose22: transposing inconsistent categories.", {
sp <- prt2
sp[1, 2] <- "no"
res <- proc_freq(sp,
tables = c("internship"),
titles = "My first Frequency Table",
by = c("sex", "enrollment"),
weight = "count")
res
res1 <- proc_transpose(res, id = c("BY1", "CAT"), copy = c("VAR"),
by = "BY2")
res1
expect_equal(ncol(res1), 7)
expect_equal(nrow(res1), 6)
})
test_that("transpose23: transpose retains original class.", {
library(tibble)
tmp <- as_tibble(prt)
res <- proc_transpose(tmp, by = sex)
res
expect_equal("tbl_df" %in% class(res), TRUE)
})
test_that("transpose24: Transpose with single by var works", {
ageg
res <- proc_transpose(ageg, by = VAR, id = CAT2, var = v(N, CNTPCT))
expect_equal(nrow(res), 2) # And gets no error
})
test_that("transpose25: transpose by retains data type.", {
s2 <- score
s2$Section <- as.integer(s2$Section)
res <- proc_transpose(s2, by = Section)
res
expect_equal(nrow(res), 6)
expect_equal(ncol(res), 6)
expect_equal(typeof(res$Section), "integer")
s2$Section <- as.double(s2$Section)
res <- proc_transpose(s2, by = Section)
res
expect_equal(nrow(res), 6)
expect_equal(ncol(res), 6)
expect_equal(typeof(res$Section), "double")
s2$Section <- ifelse(s2$Section == 1, TRUE, FALSE)
res <- proc_transpose(s2, by = Section)
res
expect_equal(nrow(res), 6)
expect_equal(ncol(res), 6)
expect_equal(typeof(res$Section), "logical")
s2$Section <- ifelse(s2$Section == TRUE, as.Date("2020-01-01"), as.Date("2021-01-01"))
s2$Section <- as.Date(s2$Section, origin = "1970-01-01")
res <- proc_transpose(s2, by = Section)
res
expect_equal(nrow(res), 6)
expect_equal(ncol(res), 6)
expect_equal(typeof(res$Section), "double")
expect_equal(class(res$Section), "Date")
})
test_that("transpose26: prefix, and suffix works with no ID.", {
res <- proc_transpose(score, prefix = "sn", suffix = "x")
res
expect_equal(names(res[2]), "sn1x")
})
test_that("transpose27: noname options works as expected.", {
res <- proc_transpose(score, var = c("Test1", "Test2", "Final"), options = noname)
res
expect_equal(nrow(res), 3)
expect_equal(ncol(res), 7)
expect_equal("NAME" %in% names(res), FALSE)
})
test_that("transpose28: by factor works as expected.", {
s2 <- score
sect <- ifelse(s2$Section == 1, "Fork", "Bork")
s2$Section <- factor(sect, c("Fork", "Bork"))
res <- proc_transpose(s2, by = Section)
res
expect_equal(nrow(res), 6)
expect_equal(ncol(res), 6)
expect_equal(typeof(res$Section), "integer")
expect_equal(class(res$Section), c("factor"))
s2 <- score
sect <- ifelse(s2$Section == 1, "Fork", "Bork")
s2$Section <- factor(sect, c("Fork", "Bork"), ordered = TRUE)
res <- proc_transpose(s2, by = Section)
res
expect_equal(nrow(res), 6)
expect_equal(ncol(res), 6)
expect_equal(typeof(res$Section), "integer")
expect_equal(class(res$Section), c("ordered", "factor"))
})
test_that("transpose29: parameter checks work.", {
expect_error(proc_transpose("bork", var = c("Student")))
expect_error(proc_transpose(score[0, ], var = c("Student")))
expect_error(proc_transpose(score, var = c("fork")))
})
Try the procs package in your browser
Any scripts or data that you put into this service are public.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Embedding an R snippet on your website
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.