@r-universe/webr 2023.6.11 → 2023.6.21

package/dist/vfs/usr/lib/R/library/grid/tests/testls.Rout.save

@@ -0,0 +1,343 @@
+
+R Under development (unstable) (2022-03-19 r81942) -- "Unsuffered Consequences"
+Copyright (C) 2022 The R Foundation for Statistical Computing
+Platform: x86_64-pc-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.
+
+> library(grid)
+> 
+> # Test hole in DL (deleted grob)
+> grid.lines(name="foo")
+> grid.lines(x=1:0, name="foo2")
+> grid.ls()
+foo
+foo2
+> grid.remove("foo")
+> grid.ls()
+foo2
+> # New blank page
+> grid.newpage()
+> 
+> 
+> #######
+> # GROBS
+> #######
+> # Plain grob
+> grid.ls(grob(name="g1"))
+g1
+> # gList
+> grid.ls(gList(grob(name="gl1"), grob(name="gl2")))
+gl1
+gl2
+> # gTree
+> grid.ls(gTree(children=gList(grob(name="child")),
++               name="parent"))
+parent
+  child
+> grid.ls(gTree(children=gList(grob(name="child1"), grob(name="child1")),
++               name="parent"))
+parent
+  child1
+  child1
+> 
+> ###########
+> # VIEWPORTS
+> ###########
+> # Plain viewport
+> grid.ls(viewport(name="vp1"),
++         view=TRUE)
+vp1
+> # vpList
+> grid.ls(vpList(viewport(name="vpl1")),
++         view=TRUE)
+vpl1
+> grid.ls(vpList(viewport(name="vpl1"), viewport(name="vpl2")),
++         view=TRUE)
+vpl1
+  1
+vpl2
+> grid.ls(vpList(viewport(name="vpl1"), viewport(name="vpl2"),
++                viewport(name="vpl3")),
++         view=TRUE)
+vpl1
+  1
+vpl2
+  1
+vpl3
+> # vpStack
+> grid.ls(vpStack(viewport(name="vps1"), viewport(name="vps2")),
++         view=TRUE)
+vps1
+  vps2
+> grid.ls(vpStack(viewport(name="vps1"), viewport(name="vps2"),
++                 viewport(name="vps3")),
++         view=TRUE)
+vps1
+  vps2
+    vps3
+> # vpTrees
+> grid.ls(vpTree(viewport(name="parentvp"), vpList(viewport(name="childvp"))),
++         view=TRUE)
+parentvp
+  childvp
+> grid.ls(vpTree(viewport(name="parentvp"),
++                vpList(viewport(name="cvp1"), viewport(name="cvp2"))),
++         view=TRUE)
+parentvp
+  cvp1
+    1
+  cvp2
+> # vpPaths
+> grid.ls(vpPath("A"),
++         view=TRUE)
+A
+> grid.ls(vpPath("A", "B"),
++         view=TRUE)
+A
+  B
+> grid.ls(vpPath("A", "B", "C"),
++         view=TRUE)
+A
+  B
+    C
+> 
+> ##########
+> # MIXTURES
+> ##########
+> # grob with vp viewport
+> g1 <- grob(vp=viewport(name="gvp"), name="g1")
+> grid.ls(g1, view=TRUE, full=TRUE)
+viewport[gvp]
+  grob[g1]
+  upViewport[1]
+> grid.ls(g1, view=TRUE, full=TRUE, grob=FALSE)
+viewport[gvp]
+  upViewport[1]
+> # grob with vp vpList
+> grid.ls(grob(vp=vpList(viewport(name="vpl")), name="g1"),
++         view=TRUE, full=TRUE)
+viewport[vpl]
+  grob[g1]
+  upViewport[1]
+> grid.ls(grob(vp=vpList(viewport(name="vpl1"), viewport(name="vpl2")),
++              name="g1"),
++         view=TRUE, full=TRUE)
+viewport[vpl1]
+  upViewport[1]
+viewport[vpl2]
+  grob[g1]
+  upViewport[1]
+> # grob with vp vpStack
+> grid.ls(grob(vp=vpStack(viewport(name="vps1"), viewport(name="vps2")),
++              name="g1"),
++         view=TRUE, full=TRUE)
+viewport[vps1]
+  viewport[vps2]
+    grob[g1]
+    upViewport[2]
+> grid.ls(grob(vp=vpStack(viewport(name="vps1"), viewport(name="vps2"),
++                viewport(name="vps3")),
++              name="g1"),
++         view=TRUE)
+vps1
+  vps2
+    vps3
+      g1
+      3
+> # grob with vp vpTree
+> grid.ls(grob(vp=vpTree(viewport(name="parentvp"),
++                vpList(viewport(name="cvp"))),
++              name="g1"),
++         view=TRUE, full=TRUE)
+viewport[parentvp]
+  viewport[cvp]
+    grob[g1]
+    upViewport[2]
+> grid.ls(grob(vp=vpTree(viewport(name="parentvp"),
++                vpList(viewport(name="cvp1"), viewport(name="cvp2"))),
++              name="g1"),
++         view=TRUE, full=TRUE)
+viewport[parentvp]
+  viewport[cvp1]
+    upViewport[1]
+  viewport[cvp2]
+    grob[g1]
+    upViewport[2]
+> # gTree with vp viewport
+> # and child grob with vp viewport
+> grid.ls(gTree(children=gList(grob(vp=viewport(name="childvp"), name="cg1"),
++                 grob(name="cg2")),
++               name="parent",
++               vp=viewport(name="parentvp")),
++         view=TRUE)
+parentvp
+  parent
+    childvp
+      cg1
+      1
+    cg2
+  1
+> # gTree with childrenvp viewport
+> grid.ls(gTree(childrenvp=viewport(name="vp"), name="gtree"),
++         view=TRUE, full=TRUE)
+gTree[gtree]
+  viewport[vp]
+    upViewport[1]
+> grid.ls(gTree(childrenvp=viewport(name="vp"), name="gtree"),
++         view=TRUE, full=TRUE, grob=FALSE)
+viewport[vp]
+  upViewport[1]
+> grid.ls(gTree(children=gList(grob(name="child")),
++               name="parent",
++               childrenvp=viewport(name="vp")),
++         view=TRUE, full=TRUE)
+gTree[parent]
+  viewport[vp]
+    upViewport[1]
+  grob[child]
+> grid.ls(gTree(children=gList(grob(name="child1"), grob(name="child2")),
++               name="parent",
++               childrenvp=viewport(name="vp")),
++         view=TRUE, full=TRUE)
+gTree[parent]
+  viewport[vp]
+    upViewport[1]
+  grob[child1]
+  grob[child2]
+> grid.ls(gTree(children=gList(grob(name="child")),
++               childrenvp=viewport(name="vp"),
++               name="parent"), 
++         view=TRUE, full=TRUE)
+gTree[parent]
+  viewport[vp]
+    upViewport[1]
+  grob[child]
+> grid.ls(gTree(children=gList(grob(name="child1"), grob(name="child2")),
++               name="parent",
++               childrenvp=viewport(name="vp")),
++         view=TRUE, full=TRUE, grob=FALSE)
+viewport[vp]
+  upViewport[1]
+> # gTree with childrenvp vpTree
+> grid.ls(gTree(childrenvp=vpTree(parent=viewport(name="vp1"),
++                 children=vpList(viewport(name="vp2"))),
++               name="gtree"),
++         view=TRUE, full=TRUE)
+gTree[gtree]
+  viewport[vp1]
+    viewport[vp2]
+      upViewport[2]
+> grid.ls(gTree(children=gList(grob(name="child")),
++               name="parent",
++               childrenvp=vpTree(parent=viewport(name="vp1"),
++                 children=vpList(viewport(name="vp2")))),
++         view=TRUE, full=TRUE)
+gTree[parent]
+  viewport[vp1]
+    viewport[vp2]
+      upViewport[2]
+  grob[child]
+> # gTree with childrenvp vpTree
+> # and child grob with vp vpPath
+> # A gTree, called "parent", with childrenvp vpTree (vp2 within vp1)
+> # and child grob, called "child", with vp vpPath (down to vp2)
+> sampleGTree <- gTree(name="parent",
++                      children=gList(grob(name="child", vp="vp1::vp2")),
++                      childrenvp=vpTree(parent=viewport(name="vp1"),
++                                        children=vpList(viewport(name="vp2"))))
+> grid.ls(sampleGTree)
+parent
+  child
+> # Show viewports too
+> grid.ls(sampleGTree, view=TRUE)
+parent
+  vp1
+    vp2
+      2
+  vp1
+    vp2
+      child
+      2
+> # Only show viewports
+> grid.ls(sampleGTree, view=TRUE, grob=FALSE)
+vp1
+  vp2
+    2
+vp1
+  vp2
+    2
+> # Alternate displays
+> # nested listing, custom indent
+> grid.ls(sampleGTree, view=TRUE, print=nestedListing, gindent="--")
+parent
+--vp1
+----vp2
+------2
+--vp1
+----vp2
+------child
+------2
+> # path listing
+> grid.ls(sampleGTree, view=TRUE, print=pathListing)
+            | parent
+vp1
+vp1::vp2
+vp1::vp2::2
+vp1
+vp1::vp2
+vp1::vp2    | parent::child
+vp1::vp2::2
+> # path listing, without grobs aligned
+> grid.ls(sampleGTree, view=TRUE, print=pathListing, gAlign=FALSE)
+ | parent
+vp1
+vp1::vp2
+vp1::vp2::2
+vp1
+vp1::vp2
+vp1::vp2 | parent::child
+vp1::vp2::2
+> # grob path listing 
+> grid.ls(sampleGTree, view=TRUE, print=grobPathListing)
+         | parent
+vp1::vp2 | parent::child
+> # path listing, grobs only
+> grid.ls(sampleGTree, print=pathListing)
+ | parent
+ | parent::child
+> # path listing, viewports only
+> grid.ls(sampleGTree, view=TRUE, grob=FALSE, print=pathListing)
+vp1
+vp1::vp2
+vp1::vp2::2
+vp1
+vp1::vp2
+vp1::vp2::2
+> # raw flat listing
+> str(grid.ls(sampleGTree, view=TRUE, print=FALSE))
+List of 6
+ $ name   : chr [1:8] "parent" "vp1" "vp2" "2" ...
+ $ gDepth : num [1:8] 0 1 1 1 1 1 1 1
+ $ vpDepth: num [1:8] 0 0 1 2 0 1 2 2
+ $ gPath  : chr [1:8] "" "parent" "parent" "parent" ...
+ $ vpPath : chr [1:8] "" "" "vp1" "vp1::vp2" ...
+ $ type   : chr [1:8] "gTreeListing" "vpListing" "vpListing" "vpUpListing" ...
+ - attr(*, "class")= chr "flatGridListing"
+> 
+> 
+> 
+> 
+> proc.time()
+   user  system elapsed 
+  0.310   0.053   0.349 

package/dist/vfs/usr/lib/R/library/grid/tests/units.R

@@ -0,0 +1,180 @@
+
+library(grid)
+
+unitCheck <- function(u1, u2) {
+    stopifnot(identical(as.character(u1), as.character(u2)))
+}
+
+# Mixture of rep() arguments based on example(rep) examples
+
+# simple tests
+simpleUnit <- unit(1:4, "npc")
+
+unitCheck(rep(simpleUnit, 2),
+          unit(rep(1:4, 2), "npc"))
+unitCheck(rep(simpleUnit, each=2),
+          unit(rep(1:4, each=2), "npc"))
+unitCheck(rep(simpleUnit, c(2, 1, 2, 1)),
+          unit(rep(1:4, c(2, 1, 2, 1)), "npc"))
+unitCheck(rep(simpleUnit, each=2, length.out=4),
+          unit(rep(1:4, each=2, length.out=4), "npc"))
+unitCheck(rep(simpleUnit, each=2, length.out=10),
+          unit(rep(1:4, each=2, length.out=10), "npc"))
+unitCheck(rep(simpleUnit, each=2, times=3),
+          unit(rep(1:4, each=2, times=3), "npc"))
+
+simpleUnitMixed <- unit(1:4, c("npc", "cm"))
+
+unitCheck(rep(simpleUnitMixed, 2),
+          unit(rep(1:4, 2), c("npc", "cm")))
+unitCheck(rep(simpleUnitMixed, each=2),
+          unit(rep(1:4, each=2),
+               rep(c("npc", "cm"), each=2)))
+unitCheck(rep(simpleUnitMixed, c(2, 1, 2, 1)),
+          unit(rep(1:4, c(2, 1, 2, 1)),
+               rep(c("npc", "cm"), c(2, 1))))
+unitCheck(rep(simpleUnitMixed, each=2, length.out=4),
+          unit(rep(1:4, each=2, length.out=4),
+               rep(c("npc", "cm"), each=2, length.out=4)))
+unitCheck(rep(simpleUnitMixed, each=2, length.out=10),
+          unit(rep(1:4, each=2, length.out=10),
+               rep(c("npc", "cm"), each=2, length.out=10)))
+unitCheck(rep(simpleUnitMixed, each=2, times=3),
+          unit(rep(1:4, each=2, times=3),
+               rep(c("npc", "cm"), each=2, times=3)))
+
+units <- c("npc", "inch", "strwidth", "cm")
+dataL <- list(NULL, NULL, "test", NULL)
+unitWithData <- unit(1:4, units, data=dataL)
+unitCheck(rep(unitWithData, 2),
+          unit(rep(1:4, 2),
+               rep(units, 2),
+               rep(dataL, 2)))
+unitCheck(rep(unitWithData, each=2),
+          unit(rep(1:4, each=2),
+               rep(units, each=2),
+               rep(dataL, each=2)))
+unitCheck(rep(unitWithData, c(2, 1, 2, 1)),
+          unit(rep(1:4, c(2, 1, 2, 1)),
+               rep(units, c(2, 1, 2, 1)),
+               rep(dataL, c(2, 1, 2, 1))))
+unitCheck(rep(unitWithData, each=2, length.out=4),
+          unit(rep(1:4, each=2, length.out=4),
+               rep(units, each=2, length.out=4),
+               rep(dataL, each=2, length.out=4)))
+unitCheck(rep(unitWithData, each=2, length.out=10),
+          unit(rep(1:4, each=2, length.out=10),
+               rep(units, each=2, length.out=10),
+               rep(dataL, each=2, length.out=10)))
+unitCheck(rep(unitWithData, each=2, times=3),
+          unit(rep(1:4, each=2, times=3),
+               rep(units, each=2, times=3),
+               rep(dataL, each=2, times=3)))
+
+# unit.arithmetic
+unitArith <- unit(1, "npc") + unit(1:2, "inch")
+
+unitCheck(rep(unitArith, 2),
+          unit(1, "npc") + unit(rep(1:2, 2), "inch"))
+unitCheck(rep(unitArith, each=2),
+          unit(1, "npc") + unit(rep(1:2, each=2), "inch"))
+unitCheck(rep(unitArith, c(2, 1)),
+          unit(1, "npc") + unit(rep(1:2, c(2 ,1)), "inch"))
+unitCheck(rep(unitArith, each=2, length.out=3),
+          unit(1, "npc") + unit(rep(1:2, each=2, length.out=3), "inch"))
+unitCheck(rep(unitArith, each=2, length.out=5),
+          unit(1, "npc") + unit(rep(1:2, each=2, length.out=5), "inch"))
+unitCheck(rep(unitArith, each=2, times=3),
+          unit(1, "npc") + unit(rep(1:2, each=2, times=3), "inch"))
+
+# unit.list
+arg1 <- unit(1, "npc") + unit(1:2, "inch")
+arg2 <- unit(3, "cm")
+unitList <- unit.c(arg1, arg2)
+
+unitCheck(rep(unitList, 2),
+          unit.c(arg1, arg2, arg1, arg2))
+unitCheck(rep(unitList, each=2),
+          unit.c(rep(arg1, each=2), rep(arg2, 2)))
+unitCheck(rep(unitList, c(2, 1, 2)),
+          unit.c(rep(arg1, c(2, 1)), rep(arg2, 2)))
+unitCheck(rep(unitList, each=2, length.out=4),
+          rep(arg1, each=2))
+unitCheck(rep(unitList, each=2, length.out=8),
+          unit.c(rep(arg1, each=2), rep(arg2, 2), rep(arg1, each=2, length.out=2)))
+unitCheck(rep(unitList, each=2, times=3),
+          unit.c(rep(arg1, each=2), rep(arg2, 2),
+                 rep(arg1, each=2), rep(arg2, 2),
+                 rep(arg1, each=2), rep(arg2, 2)))
+
+# Special test
+# rep() unit.arithmetic where operands have different lengths
+uaDiffLength <- unit(1:2, "npc") + unit(1:3, "npc")
+uaSameLength <- unit(c(1, 2, 1), "npc") + unit(1:3, "npc")
+unitCheck(rep(uaDiffLength, 2),
+          rep(uaSameLength, 2))
+
+
+# Bug report PR#14170 test
+
+x <- unit.c(unit(5,"mm"),unit(3,"npc"))
+rep(x, 2)
+rep(x, each=2)
+rep(x, c(2, 2))
+
+x <- x - unit(1,"mm")
+rep(x, 2)
+rep(x, each=2)
+rep(x, c(2, 2))
+
+
+## grid::unit.pmax, PR#14443
+x <- unit(1, "cm")
+stopifnot(length(unit.pmax(x)) == 1L, length(unit.pmin(x)) == 1L)
+## was 3 in R <= 2.12.0
+
+# Unit subassignment
+a <- unit(1:3, c("cm", "in", "npc"))
+b <- a + unit(1, "npc")
+a[2] <- unit(2,"pt")
+b[2] <- unit(2,"npc")
+
+unitCheck(a, unit(1:3, c("cm", "pt", "npc")))
+unitCheck(b, unit.c(unit(1, "cm") + unit(1, "npc"),
+                    unit(2, "npc"),
+                    unit(3, "npc") + unit(1, "npc")))
+
+c <- unit(1:10, "mm")
+
+# assign to range
+c[5:9] <- unit(9:5, "pt")
+unitCheck(c, unit(c(1:4, 9:5, 10),
+                  c(rep("mm", 4), rep("pt", 5), "mm")))
+
+# recycle
+c[2:3] <- unit(1, "in") + unit(.5, "npc")
+unitCheck(c, unit.c(unit(1, "mm"),
+                    rep(unit(1, "in") + unit(.5, "npc"), 2),
+                    unit(4, "mm"),
+                    unit(9:5, "pt"),
+                    unit(10, "mm")))
+
+# recycle non-multiple
+c[6:8] <- stringWidth(c("a", "b"))
+unitCheck(c, unit.c(unit(1, "mm"),
+                    rep(unit(1, "in") + unit(.5, "npc"), 2),
+                    unit(4, "mm"),
+                    unit(9, "pt"),
+                    stringWidth(c("a", "b", "a")),
+                    unit(5, "pt"),
+                    unit(10, "mm")))
+
+## Bug fix for sum() of complex units
+u1 = 0.4*sum(unit(1, "inch"), unit(1, "mm"))
+u2 = 0.1*sum(unit(1, "inch"), unit(1, "mm"))
+unitCheck(u1 + u2,
+          0.5*sum(unit(1, "inch"), unit(1, "mm")))
+unitCheck(sum(u1, u2),
+          sum(unit(c(0.4, .4, .1, .1), c("in", "mm", "in", "mm"))))
+unitCheck(sum(unit.c(u1, u2)),
+          sum(unit(c(0.4, .4, .1, .1), c("in", "mm", "in", "mm"))))