Update test_kit.Rout.save

2005m · Oct 26, 2022 · 3dce4dc · 3dce4dc
1 parent edf5ec3
commit 3dce4dc
Showing 1 changed file with 65 additions and 14 deletions.
diff --git a/tests/test_kit.Rout.save b/tests/test_kit.Rout.save
@@ -1760,23 +1760,74 @@ Attaching kit 0.0.12 (OPENMP enabled using 1 thread)
 > check("0027.004", panyNA(w), c(TRUE, FALSE, FALSE, FALSE))
 > check("0027.005", panyNA(x), c(FALSE, FALSE, TRUE, FALSE))
 > 
+> rm(v,w,x,y,z,f1,d1)
+>
 > # --------------------------------------------------------------------------------------------------
-> #                                   pfirst
-> # --------------------------------------------------------------------------------------------------
-> 
-> check("0028.001", pfirst(v), v)
-> check("0028.002", pfirst(x, y), c(1, 3, 4, 5))
-> check("0028.003", pfirst(w), w)
-> 
-> # --------------------------------------------------------------------------------------------------
-> #                                   plast
+> #                                   pfirst and plast
 > # --------------------------------------------------------------------------------------------------
 > 
-> check("0029.001", plast(v), v)
-> check("0029.002", plast(x, y), c(2, 3, 4, 1))
-> check("0029.003", plast(w), w)
-> 
-> rm(v,w,x,y,z,f1,d1)
+> x = c(1, 3, NA, 5)
+> y = c(2, NA, 4, 1)
+> z = c(3, 4, 4, NA)
+> x1 = sample(c("a","b",NA),1e2,TRUE)
+> y1 = sample(c("c","d",NA),1e2,TRUE)
+> z1 = sample(c("e","f",NA),1e2,TRUE)
+> 
+> base_pfirst <- function(...) {
+>   x = if(...length() == 1L && is.list(..1)) unclass(..1) else list(...)
+>   res = x[[1]]
+>   if(length(x) == 1L) return(res)
+>   for(i in 2:length(x)) {
+>     miss <- is.na(res)
+>     res[miss] <- x[[i]][miss]
+>   }
+>   res
+> }
+> 
+> base_plast <- function(...) {
+>   x = if(...length() == 1L && is.list(..1)) unclass(..1) else list(...)
+>   n = length(x)
+>   res = x[[n]]
+>   if(n == 1L) return(res)
+>   for(i in (n-1):1) {
+>     miss <- is.na(res)
+>     res[miss] <- x[[i]][miss]
+>   }
+>   res
+> }
+> 
+> check("0028.001", pfirst(x, y, z), base_pfirst(x, y, z))
+> check("0028.002", plast(x, y, z), base_plast(x, y, z))
+> check("0028.003", pfirst(y, z, x), base_pfirst(y, z, x))
+> check("0028.004", plast(y, z, x), base_plast(y, z, x))
+> 
+> check("0028.005", pfirst(x1, y1, z1), base_pfirst(x1, y1, z1))
+> check("0028.006", plast(x1, y1, z1), base_plast(x1, y1, z1))
+> check("0028.007", pfirst(y1, z1, x1), base_pfirst(y1, z1, x1))
+> check("0028.008", plast(y1, z1, x1), base_plast(y1, z1, x1))
+> 
+> check("0028.009", pfirst(list(x1, y1, z1)), base_pfirst(list(x1, y1, z1)))
+> check("0028.010", plast(list(x1, y1, z1)), base_plast(list(x1, y1, z1)))
+> check("0028.011", pfirst(data.frame(y1, z1, x1)), base_pfirst(data.frame(y1, z1, x1)))
+> check("0028.012", plast(data.frame(y1, z1, x1)), base_plast(data.frame(y1, z1, x1)))
+> 
+> check("0028.013", pfirst(list(1, NULL), list(NULL, 2)), list(1, 2))
+> check("0028.014", plast(list(1, NULL), list(NULL, 2)), list(1, 2))
+> 
+> check("0028.015", pfirst(as.character(z), y), error = "All arguments need to have the same data type, except for numeric and logical types")
+> check("0028.016", pfirst(x, y, 1:2), error = "Argument 3 is of length 2 but argument 1 is of length 4. If you wish to 'recycle' your argument, please use rep() to make this intent clear to the readers of your code.")
+> check("0028.017", pfirst(1:10, 1:5), error = "Argument 2 is of length 5 but argument 1 is of length 10. If you wish to 'recycle' your argument, please use rep() to make this intent clear to the readers of your code.")
+> check("0028.018", pfirst(x, as.list(z), y), error = "All arguments need to have the same data type, except for numeric and logical types")
+> 
+> check("0028.019", typeof(pfirst(1:4, x)), "double")
+> check("0028.020", typeof(pfirst(x, 1:4)), "double")
+> 
+> check("0028.021", pfirst(as.factor(x), x), error = "If one argument is a factor, all arguments need to be factors")
+> check("0028.022", pfirst(x, as.factor(x)), error = "If one argument is a factor, all arguments need to be factors")
+> check("0028.023", pfirst(as.factor(x), as.factor(y)), error = "All factors need to have identical levels")
+> check("0028.024", class(pfirst(as.factor(x1), as.factor(x1))), "factor")
+> 
+> rm(x, y, z, x1, y1, z1, base_pfirst, base_plast)
 > 
 > # --------------------------------------------------------------------------------------------------
 > #                                   CLEAN FUNCTIONS