examplesnewdemo <- function (file, no = 1, start = TRUE) { 'require("tcltk")'; where<-environment() chunks<-c( "#0:" ,"##start:##" ,"##:start##" ,"#:0" ,"##echo = FALSE, results=hide:##" ,"#1:" ,"source(\"pic.plot.R\"); options(continue = \" \")" ,"\"ok\"" ,"#:1" ,"#13:" ,"source(\"pic.plot.R\"); options(continue = \" \")" ,"\"ok\"" ,"#:13" ,"#24:" ,"source(\"pic.plot.R\"); options(continue = \" \")" ,"\"ok\"" ,"#:24" ,"#44:" ,"source(\"pic.plot.R\"); options(continue = \" \")" ,"\"ok\"" ,"#:44" ,"#68:" ,"source(\"pic.plot.R\"); options(continue = \" \")" ,"\"ok\"" ,"#:68" ,"#91:" ,"source(\"../grp.plot.R\")" ,"\"ok\"" ,"#:91" ,"##:echo = FALSE, results=hide##" ,"##results=verbatim:##" ,"#2:" ,"margin.table(Titanic/10, 2:1)[2:1,]" ,"#:2" ,"#14:" ,"HairEyeColor" ,"dimnames(HairEyeColor)" ,"#:14" ,"#65:" ,"data <- HairEyeColor" ,"data.exp <- margin.table(data, 1)" ,"for( d in 2:length(dim(data)) ){" ," data.exp <- outer( data.exp, margin.table(data, d) ) / sum(data)" ,"}" ,"cat(\"=== observed ===\\n\"); print(data)" ,"cat(\"=== expected ===\\n\"); print(round(data.exp, 3))" ,"#:65" ,"#66:" ,"data.diff <- data.exp - data" ,"cat(\"=== deviation: expected - observed ===\\n\"); print(round(data.diff, 3))" ,"#:66" ,"##:results=verbatim##" ,"##fig=TRUE,results=hide:##" ,"#3:" ,"pic.plot(data = Titanic/10, grp.color = Survived)" ,"#:3" ,"#4:" ,"pic.plot(data = 148)" ,"#:4" ,"#5:" ,"pic.plot(data = 148, " ," pic.aspect = 0.25, " ," main = \"frequency, aspect ratio 0.25\")" ,"#:5" ,"#6:" ,"pic.plot(data = 148, " ," pic.aspect = 1, " ," main = \"frequency -- setting pic.aspect = 1\")" ,"#:6" ,"#7:" ,"pic.plot(data = 148, " ," pic.aspect = 4, " ," colors = \"orange\"," ," main = \"frequency, aspect ratio 4, color orange\")" ,"#:7" ,"#8:" ,"pic.plot(data = 148, " ," pic.aspect = 1, " ," pic.space.factor = 0, " ," colors = \"lightblue\"," ," main = \"frequency, zero space between pics, red\")" ,"#:8" ,"#15:" ,"pic.plot(HairEyeColor, grp.xy = NULL," ," grp.color = Sex, " ," colors = c(\"lightblue\", \"pink\")," ," pic.space.factor = 0," ," main = \"color grouping by vars Sex\")" ,"#:15" ,"#16:" ,"pic.plot(HairEyeColor, grp.xy = NULL, " ," grp.color = 1, " ," pic.space.factor = 0.3, " ," lab.legend = \"cols\"," ," main = \"color grouping by V1, legend not parallel\")" ,"#:16" ,"#17:" ,"pic.plot(HairEyeColor, " ," grp.color = 1, " ," colors = topo.colors(4)," ," pic.space.factor = c(0, 0.4), " ," pic.aspect = 2," ," lab.legend = \"rows\", " ," lab.cex = 0.8," ," main = \"topo.colors, smaller letters in the legend\", grp.xy = NULL)" ,"#:17" ,"#18:" ,"pic.plot(HairEyeColor, " ," grp.color = 2, " ," colors = 1:4, " ," pic.frame = FALSE, " ," pic.space.factor = 0, " ," lab.cex = 0.8," ," main = \"colors defined by 1:4, no pic.frames\", grp.xy = NULL)" ,"#:18" ,"#19:" ,"pic.plot(HairEyeColor, " ," grp.color = 1, " ," grp.pic = 2, " ," main = \"grouping by color and central symbols\", grp.xy = NULL)" ,"#:19" ,"#20:" ,"pic.plot(HairEyeColor, " ," grp.color = Hair, " ," grp.pic = Eye," ," colors = c(\"black\", \"brown\", \"red\", \"yellow2\")," ," pics = 15:18," ," pic.frame = FALSE, " ," panel.frame = FALSE," ," main = \"grouping by color and icons, without frames\", grp.xy = NULL)" ,"#:20" ,"#21:" ,"pic.plot(HairEyeColor, " ," grp.pic = \"Sex\", " ," grp.color = \"Hair\", " ," pics = c(17, 6)," ," colors = c(\"black\", \"brown\", \"red\", \"yellow2\")," ," pic.frame = FALSE, " ," pic.space.factor = 0," ," lab.legend = \"cols\", " ," main = \"grouping by color and central symbols\", grp.xy = NULL)" ,"#:21" ,"#22:" ,"pic.plot(aperm(HairEyeColor, c(2,1,3)), grp.xy = NULL," ," grp.pic = Sex, " ," grp.color = Hair, " ," pics = c(15, 17)," ," colors = c(\"black\", \"brown\", \"red\", \"yellow2\")," ," pic.frame = FALSE, " ," pic.space.factor = 0, " ," lab.legend = \"cols\", " ," main = \"grouping by color and central symbols\") " ,"#:22" ,"#23:" ,"pic.plot(aperm(HairEyeColor, c(2,1,3)), " ," grp.pic = Hair, " ," grp.color = Sex, " ," colors = c(\"blue\", \"red\")," ," pics = c(1, 3, 6, 8)," ," pic.frame = FALSE, " ," pic.space.factor = 0, " ," panel.frame = FALSE, " ," lab.legend = \"cols\", " ," main = \"grouping by color and central symbols\", grp.xy = NULL)" ,"#:23" ,"#25:" ,"par(mfrow = c(2,2))" ,"pic.plot(HairEyeColor, grp.color = 2, lab.cex = 0.7, pic.space.factor = 0," ," pic.horizontal = TRUE, pic.stack.type = \"tl\", " ," pic.stack.len = 30, " ," main = '\"tl\", stack.len 30', pic.frame = FALSE, grp.xy = NULL)" ,"pic.plot(HairEyeColor, grp.color = 2, lab.cex = 0.7, pic.space.factor = 0," ," pic.horizontal = TRUE, pic.stack.type = \"tr\", " ," pic.stack.len = 30, " ," main = '\"tr\", stack.len 30', pic.frame = FALSE, grp.xy = NULL)" ,"pic.plot(HairEyeColor, grp.color = 2, lab.cex = 0.7, pic.space.factor = 0," ," pic.horizontal = TRUE, pic.stack.type = \"bl\", " ," pic.stack.len = 30, " ," main = '\"bl\", stack.len 30', pic.frame = FALSE, grp.xy = NULL)" ,"pic.plot(HairEyeColor, grp.color = 2, lab.cex = 0.7, pic.space.factor = 0," ," pic.horizontal = TRUE, pic.stack.type = \"br\", " ," pic.stack.len = 30, " ," main = '\"br\", stack.len 30', pic.frame = FALSE, grp.xy = NULL)" ,"par(mfrow = c(1,1))" ,"mtext(\"horizontal layouts for stacks, different settings of pic.stack.type\", " ," cex = 1.2, side = 1, line = 4)" ,"#:25" ,"#26:" ,"par(mfrow = c(2,2))" ,"pic.plot(HairEyeColor, grp.color = 2, lab.cex = 0.7, pic.space.factor = 0," ," pic.horizontal = FALSE, pic.stack.type = \"tl\", " ," pic.stack.len = 30, " ," main = '\"tl\", stack.len 30', pic.frame = FALSE, grp.xy = NULL)" ,"pic.plot(HairEyeColor, grp.color = 2, lab.cex = 0.7, pic.space.factor = 0," ," pic.horizontal = FALSE, pic.stack.type = \"tr\", " ," pic.stack.len = 30, " ," main = '\"tr\", stack.len 30', pic.frame = FALSE, grp.xy = NULL)" ,"pic.plot(HairEyeColor, grp.color = 2, lab.cex = 0.7, pic.space.factor = 0," ," pic.horizontal = FALSE, pic.stack.type = \"bl\", " ," pic.stack.len = 30, " ," main = '\"bl\", stack.len 30', pic.frame = FALSE, grp.xy = NULL)" ,"pic.plot(HairEyeColor, grp.color = 2, lab.cex = 0.7, pic.space.factor = 0," ," pic.horizontal = FALSE, pic.stack.type = \"br\", " ," pic.stack.len = 30, " ," main = '\"br\", stack.len 30', pic.frame = FALSE, grp.xy = NULL)" ,"par(mfrow = c(1,1))" ,"mtext(\"horizontal layouts for stacks, different settings of pic.stack.type\", " ," cex = 1.2, side = 1, line = 4)" ,"#:26" ,"#27:" ,"pic.plot(HairEyeColor, " ," grp.xy = Hair ~ 0, " ," grp.color = Hair, " ," colors = c(\"black\", \"brown\", \"red\", \"yellow2\")," ," pic.stack.type = \"tl\", " ," main = \"y- and color grouping induced by the same variable\")" ,"#:27" ,"#28:" ,"pic.plot(HairEyeColor," ," grp.xy = Hair ~ 0, " ," grp.color = Sex, " ," pic.stack.type = \"lt\"," ," pic.horizontal = FALSE," ," pic.frame = FALSE, " ," main = \"grouping by y and by colors, different variables\")" ,"#:28" ,"#29:" ,"pic.plot(HairEyeColor, " ," grp.xy = 0 ~ 1, # or: grp.xy = 0 ~ Hair" ," grp.color = 2, # or: grp.color = Sex" ," pic.stack.type = \"tr\", " ," pic.space.factor = c(0, 0.4)," ," main = \"grouping by x and by colors\")" ,"#:29" ,"#30:" ,"pic.plot(HairEyeColor, " ," grp.xy = ~ Hair, " ," grp.color = Eye, " ," grp.pic = Sex, " ," pics = c(2, 6)," ," pic.frame = FALSE, " ," pic.horizontal = FALSE, " ," panel.frame = FALSE," ," main = \"grouping by x and colors and icons\")" ,"#:30" ,"#31:" ,"pic.plot(HairEyeColor, " ," grp.xy = Hair ~ Eye, " ," grp.color = Sex, " ," pic.stack.type = \"bl\"," ," panel.frame = FALSE," ," main = \"grouping by x and y and by colors\")" ,"#:31" ,"#32:" ,"pic.plot(HairEyeColor, " ," grp.xy = Hair ~ Sex, " ," grp.color = Sex, " ," colors = c(\"blue\", \"pink\")," ," pic.frame = FALSE," ," pic.space = 0," ," main = \"grouping by x and y and by colors\")" ,"#:32" ,"#33:" ,"pic.plot(HairEyeColor, " ," grp.xy = \"Eye ~ Hair\"," ," grp.color = Sex, " ," grp.pic = Sex, " ," pic.stack.type = \"b\", " ," pic.frame = FALSE," ," main = \"grouping by x and y, by colors and by pics\")" ,"#:33" ,"#34:" ,"pic.plot(HairEyeColor," ," grp.xy = ~ Sex + Eye, " ," grp.color = Hair, " ," colors = c(\"black\", \"brown\", \"red\", \"yellow2\")," ," main = \"grouping 2 vars in x\")" ,"#:34" ,"#35:" ,"pic.plot(HairEyeColor, " ," grp.xy = 3 + 2 ~ 0, " ," grp.color = 1, " ," lab.parallel = c(NA, FALSE)," ," main = \"grouping 2 vars in y\")" ,"#:35" ,"#36:" ,"pic.plot(HairEyeColor," ," grp.xy = 0 ~ 1 + 2," ," grp.color = 3, " ," pic.stack.type = \"bl\"," ," lab.parallel = c(FALSE, NA), " ," pic.aspect = .5, " ," panel.frame = FALSE," ," lab.color = \"lightblue\", " ," lab.boxes = 0, " ," lab.cex = 0.8," ," main = \"grouping 2 vars in x, compact labs\")" ,"#:36" ,"#37:" ,"pic.plot(HairEyeColor, " ," grp.xy = 2 + 1 ~ 0, " ," grp.color = 3, " ," pic.aspect = .3," ," pic.stack.type = \"r\", " ," pic.frame = FALSE," ," panel.frame = FALSE," ," lab.cex = 0.8, " ," lab.boxes = 1, " ," lab.color = \"lightgreen\", " ," lab.side = \"r\", " ," lab.parallel = c(TRUE, FALSE), " ," main = \"grouping 2 vars in y, compact lab design\")" ,"#:37" ,"#38:" ,"pic.plot(HairEyeColor, " ," grp.xy = 1 ~ 3 + 2, " ," grp.color = 3, " ," main = \"grouping: by 1~3+2 and by color\")" ,"#:38" ,"#39:" ,"pic.plot(HairEyeColor, " ," grp.xy = 1 + 3 ~ 2, " ," grp.color = 3, " ," pic.aspect = 0.25," ," pic.stack.len = 20," ," pic.frame = FALSE," ," pic.space.factor = c(0.3, 0.05)," ," panel.frame = FALSE," ," lab.side = \"tl\", " ," lab.boxes = 1.3," ," lab.color = c(\"lightgreen\", \"lightblue\")," ," lab.parallel = c(TRUE, FALSE), " ," lab.cex = 0.8, " ," main = \"grouping: 1+3~2 and by color, margin labs variations\")" ,"#:39" ,"#40:" ,"pic.plot(HairEyeColor, " ," grp.xy = 2 + 1 ~ 3," ," grp.color = 1, " ," colors = c(\"black\", \"brown\", \"red\", \"#FFCC22\"), " ," pic.stack.type = \"lt\", " ," pic.frame = FALSE," ," pic.stack.len = 30, " ," pic.space.factor = 0.0, " ," panel.space.factor = c(0.1, 0.1)," ," panel.margin = c(0.2, 0.01, 0.01, 0.01)," ," lab.parallel = c(TRUE, FALSE), " ," lab.color = c(\"lightblue\", \"blue\")," ," lab.side = \"bl\", " ," lab.boxes = 1.3, " ," lab.cex = 0.8, " ," main = \"grouping: 2+1~3 and by color, margins modified\")" ,"text(1.5, 0, \"additional info in additional space\", cex = 2)" ,"#:40" ,"#41:" ,"pic.plot(HairEyeColor, " ," grp.xy = 1 ~ 2 + 3, " ," grp.color = 2, " ," colors = heat.colors(4)," ," pic.stack.type = \"lb\"," ," pic.stack.len = 7, " ," pic.space.factor = 0.0, " ," pic.frame = FALSE," ," panel.space.factor = c(0, 0.2)," ," lab.parallel = c(TRUE, FALSE), " ," lab.color = c(\"lightblue\", \"green\")," ," lab.side = \"br\", " ," lab.boxes = 0.2," ," lab.cex = 0.8, " ," main = \"grouping: 1~2+3 and by color, margin labs variations\") " ,"#:41" ,"#42:" ,"pic.plot(HairEyeColor, " ," grp.xy = 2 + 1 + 3 ~ 0," ," grp.color = 3, " ," pic.aspect = 0.3," ," pic.stack.type = \"lt\", " ," pic.frame = FALSE," ," panel.frame = FALSE, " ," lab.parallel = c(FALSE, FALSE), " ," lab.color = \"lightgreen\"," ," lab.boxes = FALSE, " ," lab.cex = 0.7, " ," lab.n.max = c(3, 32)," ," main = \"groupings: by 2+1+3~0 and by col\")" ,"#:42" ,"#43:" ,"pic.plot(HairEyeColor, " ," grp.xy = 3 + 2 ~ 1, " ," grp.color = 2, " ," pic.stack.type = \"lb\", " ," pic.horizontal = TRUE, " ," pic.stack.len = 10, " ," pic.space.factor = c(.1, .3), " ," pic.aspect = NA, " ," pic.frame = FALSE," ," panel.space.factor = 0.1, " ," lab.boxes = 0.3, " ," lab.color = \"grey\"," ," lab.side = \"tl\", " ," lab.parallel = TRUE, " ," lab.cex = 0.8," ," lab.type = \"expanded\", " ," main = \"groupings: 3 + 2 ~ 1 and by color\")" ,"#:43" ,"#45:" ,"pic.plot(trees, " ," grp.xy = Height ~ Girth," ," grp.color = Volume, " ," pic.stack.type = \"b\", " ," pic.frame = FALSE," ," lab.parallel = c(FALSE, FALSE), " ," main = \"grouping by x and y, by colors and by pics\")" ,"#:45" ,"#46:" ,"pic.plot(trees, " ," grp.xy = Height ~ Girth," ," grp.color = Volume, " ," vars.to.factor = c(3, 4)," ," lab.cex = 0.7," ," main = \"grouping by x and y, and by colors\")" ,"#:46" ,"#47:" ,"pic.plot(trees, " ," grp.xy = Height ~ Girth," ," grp.color = Volume, " ," vars.to.factor = 1 / c(3, 4, 5)," ," lab.cex = 0.7," ," main = \"grouping by x and y, and by colors\")" ,"#:47" ,"#48:" ,"pic.plot(trees, " ," grp.xy = Girth ~ Volume," ," grp.color = Height, " ," vars.to.factors = 1/c(5, 6, 6)," ," colors = rainbow(6, start = 0.05, end = 0.3)," ," pic.frame = FALSE," ," pic.stack.type = \"b\", " ," pic.aspect = 0.15, " ," panel.frame = TRUE," ," main = \"grouping by x and y, and by colors\")" ,"#:48" ,"#50:" ,"pic.plot(Titanic, " ," grp.xy = Age ~ Class," ," grp.color = Survived, " ," main = \"xy by 'Age' and 'Class', colors by 'Survived'\")" ,"#:50" ,"#51:" ,"pic.plot(Titanic, " ," grp.xy = Survived ~ Class + Sex," ," grp.color = Age, " ," colors = c(\"red\", \"lightblue\")," ," pic.stack.type = \"b\", " ," pic.frame = FALSE," ," pic.space.factor= 0.5," ," panel.frame = FALSE," ," lab.boxes = 0.3," ," lab.color = \"lightgreen\"," ," main = \"x by 'Class*Sex', y by 'Survived', colors by 'Age'\") " ,"#:51" ,"#52:" ,"pic.plot(Titanic, " ," grp.xy = Age ~ Class," ," grp.color = Survived, " ," pic.space.factor = 0.5," ," panel.prop.to.size = c(FALSE, TRUE)," ," lab.boxes = 0.3," ," lab.color = \"lightgreen\"," ," main = \"xy by 'Age' and 'Class', colors by 'Survived'\")" ,"#:52" ,"#53:" ,"pic.plot(Titanic, " ," grp.xy = Age ~ Class," ," grp.color = Survived, " ," pic.space.factor = 0.5," ," panel.prop.to.size = c(TRUE, TRUE), # <-" ," lab.boxes = 0.3," ," lab.color = \"lightgreen\"," ," main = \"xy: 'Age', 'Class' / color: 'Survived'\")" ,"#:53" ,"#54:" ,"pic.plot(Titanic, " ," grp.xy = Survived ~ Class + Sex," ," grp.color = Age, " ," colors = c(\"red\", \"green\")," ," pic.stack.type = \"b\", " ," pic.frame = FALSE," ," pic.space.factor = 0.5," ," panel.prop.to.size = c(TRUE, TRUE, TRUE), " ," panel.frame = FALSE," ," lab.boxes = 0.5," ," lab.parallel = c(FALSE, TRUE, TRUE)," ," lab.color = \"lightgreen\"," ," main = \"x:'Class*Sex', y:'Survived', colors:'Age'\") " ,"#:54" ,"#55:" ,"pic.plot(Titanic, " ," grp.xy = Survived ~ Class + Sex," ," grp.color = Age, " ," colors = c(\"red\", \"green\")," ," pic.stack.type = \"b\", " ," pic.frame = FALSE," ," pic.space.factor = 0.5," ," panel.prop.to.size = c(0.7, 0.3), # <- changed" ," panel.frame = TRUE, # <- changed" ," lab.boxes = 0.3," ," lab.parallel = c(FALSE, TRUE, TRUE)," ," lab.color = \"lightgreen\"," ," lab.cex = 0.7," ," main = \"x by 'Class*Sex', y by 'Survived', colors by 'Age'\") " ,"#:55" ,"#56:" ,"par(mfrow = 2:1)" ,"mosaicplot(HairEyeColor)" ,"pic.plot(HairEyeColor, " ," grp.xy = Eye ~ Hair + Sex, " ," lab.parallel = c(TRUE, FALSE)," ," colors = \"red\", " ," pic.space.factor = 0.5, " ," pic.aspect = 2," ," panel.reverse.y = TRUE, " ," panel.prop.to.size = TRUE," ," lab.cex = 0.6, " ," lab.boxes = 1, " ," lab.color = \"grey\", " ," panel.margin = c(0.00,.035,0.0,.050)," ," main = 'HairEyeColor: grp.xy = Eye ~ Hair + Sex')" ,"par(mfrow=c(1,1)) " ,"#:56" ,"#57:" ,"pic.plot(Titanic / 10, " ," grp.xy = Survived ~ Class + Sex," ," grp.color = Age, " ," colors = c(\"red\", \"blue\")," ," pic.stack.type = \"b\", " ," pic.frame = FALSE," ," pic.space.factor= 0.5," ," panel.frame = FALSE," ," lab.boxes = 0.3," ," lab.color = \"lightgreen\"," ," main = \"x by 'Class*Sex', y by 'Survived', colors by 'Age'\") " ,"#:57" ,"#58:" ,"pic.plot(Titanic / 10, " ," grp.xy = Age ~ Class," ," grp.color = Survived, " ," panel.prop.to.size = c(TRUE, TRUE)," ," main = \"xy by 'Age' and 'Class', colors by 'Survived'\")" ,"#:58" ,"#59:" ,"pic.plot(margin.table(Titanic / 10, c(1, 3, 4)), " ," grp.xy = Age ~ Class," ," grp.color = Survived, " ," panel.prop.to.size = c(TRUE, TRUE)," ," main = \"xy:'Age' / 'Class', colors:'Survived'\")" ,"#:59" ,"#61:" ,"pic.plot(mw," ," grp.xy = Sex ~ Age, " ," grp.color = Age, " ," pic.aspect = 2, " ," pic.stack.type = rep(c(\"t\", \"b\"), nrow(mw)), " ," pic.horizontal = FALSE," ," pic.space.factor = 0," ," pic.frame = FALSE, " ," panel.frame = FALSE, " ," panel.space.factor = c(.0, .02), " ," lab.n.max = c(3, 10)," ," main = paste(\"pyramide of a population, 2014\"))" ,"#:61" ,"#62:" ,"pic.plot(HairEyeColor / sum(HairEyeColor), " ," grp.xy = Eye ~ Hair, " ," grp.color = Sex, " ," pic.horizontal = FALSE," ," main = paste(\"HairEyeColor: relative frequencies\"))" ,"#:62" ,"#63:" ,"pic.plot(HairEyeColor / max(HairEyeColor), " ," grp.xy = Eye ~ Hair, " ," grp.color = Sex, " ," pic.horizontal = FALSE," ," main = paste(\"HairEyeColor: relative frequencies\"))" ,"#:63" ,"#64:" ,"pic.plot(Titanic / max(Titanic), " ," grp.xy = Class ~ Sex + Age + Survived, " ," grp.color = Survived, " ," colors = c(\"black\", \"green\"), " ," pic.stack.type = \"b\"," ," pic.horizontal = FALSE, " ," panel.frame = FALSE," ," panel.space.factor = 0.05, " ," pic.space.factor = 0.103, " ," pic.aspect = 0.5," ," lab.box = 1.2," ," lab.color = c(\"lightgrey\", \"lightgrey\")," ," lab.cex = 0.7," ," main = \"Titanic: relative frequencies\")" ,"#:64" ,"#67:" ,"pic.plot(data.diff, " ," grp.xy = Hair + sign ~ Eye + Sex, " ," grp.color = sign, " ," colors = c( \"red\", \"green\")," ," pic.stack.type = c(\"t\",\"b\"), " ," panel.reverse.y = TRUE," ," lab.boxes = 1.2, " ," lab.color = \"lightblue\"," ," main = \"deviations from expectation: HairEyeColor\")" ,"#:67" ,"#70:" ,"image1 <- as.raster( matrix( c(1,1,1,1,0,1,1,1,1), ncol = 3, nrow = 3))" ,"image2 <- as.raster( matrix( c(0,1,0,1,0,1,0,1,0), ncol = 3, nrow = 3))" ,"image3 <- as.raster( matrix( c(0,0,0,0,1,0,0,0,0), ncol = 3, nrow = 3))" ,"p.set <- list(image1, image2, image3)" ,"pic.plot(trees, " ," grp.xy = 1 ~ 2," ," grp.color = 3," ," grp.pic = 3, " ," colors = heat.colors(3)," ," pics = p.set, " ," pic.draft = FALSE," ," vars.to.factors = c(.3, 4, .3)," ," lab.parallel = c(TRUE, TRUE, FALSE)," ," main = \"three pictograms to represent different volumes\")" ,"#:70" ,"#71:" ,"n <- 200; m <- n/2; x <- y <- seq(n <- 200); f <- floor" ,"image1 <- (outer( (x-m)^2, (y-m)^2, FUN=\"+\") > (.8*m)^2 )" ,"image2 <- (outer( (x-m)^2, (y-m)^2, FUN=\"+\") > (.6*m)^2 )" ,"image3 <- image1 | !image2; image3[,f(.75*n):n] <- 1" ,"image3[f(0.47*n):f(0.4*n), f(.05*n):f(.65*n)] <- 0" ,"image3[f(0.53*n):f(0.6*n), f(.05*n):f(.60*n)] <- 0" ,"image <- as.raster(image3) " ,"pic.plot(trees, " ," grp.xy = 1 ~ 2," ," grp.color = 3," ," grp.pic = 3, " ," colors = c(\"red\", \"blue\", \"green\")," ," pics = image, " ," pic.draft = FALSE," ," pic.frame = FALSE," ," vars.to.factors = c(.3, 4, .3)," ," lab.boxes = 1," ," main = \"second raster pictogram plot\")" ,"#:71" ,"#72:" ,"pic.plot(trees, " ," grp.xy = 1 ~ 2," ," grp.pic = 3, " ," pics = \"R.pnm\", " ," vars.to.factors = c(2, 3, .9)," ," main = \"pictograms defined by pnm file\")" ,"#:72" ,"#73:" ,"pic.plot(cbind(trees, pic = 1), " ," grp.xy = 1 ~ 2," ," grp.color = 3," ," grp.pic = \"pic\", " ," pics = \"R.pnm\", " ," vars.to.factors = c(2, 3, 6)," ," lab.parallel = c(TRUE, TRUE, FALSE)," ," main = \"colored R logos as pictograms\")" ," par(pin = c(10, 10) / 2.54) " ,"#:73" ,"#74:" ,"data <- cbind(trees, pic = 1, " ," fraction.1 = trees[,3] / max(trees[,3]) )" ,"pic.plot(data, " ," grp.xy = 1 ~ 2," ," grp.color = Volume," ," grp.pic = pic, " ," pics = \"R.pnm\", " ," vars.to.factors = c(3, 3, 5)," ," pic.stack.type = \"tls\"," ," pic.space.factor = 0.0," ," pic.frame = FALSE," ," lab.parallel = c(TRUE, TRUE, FALSE)," ," main = \"colored R logos of different sizes\")" ,"#:74" ,"#75:" ,"p.set <- c(\"m2.pnm\", \"f2.pnm\")" ,"data <- margin.table(Titanic/100, 2:4)" ,"pic.plot(data, " ," grp.xy = Age ~ Sex," ," grp.color = Survived, " ," grp.pic = Sex, " ," colors = c(\"black\", \"green\")," ," pics = p.set, " ," vars.to.factors = c(2, 3, 6)," ," panel.prop.to.size = 0.7," ," panel.reverse.y = TRUE," ," pic.stack.type = \"s\"," ," pic.frame = FALSE," ," pic.space.factor = 0.05," ," lab.parallel = c(TRUE, TRUE, FALSE)," ," main = \"Sex, Age, Survived of Titanic data in 100\")" ,"#:75" ,"#77:" ,"data <- goettingenniedersachs" ,"data <- cbind(data, fraction.1 = (data[,3] / max(data[,3]))^.5)" ,"pic.plot(data, " ," grp.xy = Eur ~ qm ," ," grp.pic = qm, " ," pics = \"tm.pnm\", " ," vars.to.factors = c(1, .5, .3)," ," pic.stack.type = \"s\"," ," pic.frame = FALSE," ," pic.space.factor = 0.05," ," panel.frame = FALSE," ," panel.space.factor = 0.2," ," panel.prop.to.size = 0.7," ," lab.parallel = c(TRUE, TRUE, FALSE)," ," main = \"rentals of some flats in Goettingen 2015/12\")" ,"#:77" ,"#78:" ,"pic.plot(data, " ," grp.xy = Eur ~ qm ," ," grp.pic = qm, " ," grp.color = Zimmer," ," pics = \"tm.pnm\", " ," vars.to.factors = c(1, .5, .3)," ," pic.stack.type = \"s\"," ," pic.frame = FALSE," ," pic.space.factor = 0.05," ," panel.frame = FALSE," ," panel.space.factor = 0.2," ," panel.prop.to.size = 0.7," ," lab.parallel = c(TRUE, TRUE, FALSE)," ," main = \"rentals of flats in Goettingen 2015/12\")" ,"#:78" ,"#79:" ,"circle.simple <- function(){" ," res <- rbind( c( 5,5,5,5, lwd.mm = 100, NA)); class(res) <- \"segments\"; res }" ,"xyxylc <- circle.simple(); xyxylc[ is.na(xyxylc[, 6]), 6] <- 3" ,"dev.fac <- 1; mm.to.lwd <- function(lwd.mm) lwd.mm * 3.787878 * dev.fac " ,"par(pin = c(10, 10) / 2.54); plot(1, type = \"n\", axes = FALSE); " ,"par(usr = c(0,10,0,10)); axis(1); axis(2)" ,"segments(xyxylc[,1], xyxylc[,2], xyxylc[,3], xyxylc[,4]," ," lwd = mm.to.lwd(xyxylc[,5]), col = xyxylc[,6])" ,"#:79" ,"#80:" ,"cross.simple <- function(data.row = NULL){ " ," res <- rbind( c( 0.5, 0.5, 9.5, 9.5, lwd.mm = 10, NA), " ," c( 0.5, 9.5, 9.5, 0.5, lwd.mm = 10, NA)," ," c( 5, 5, 5, 5, lwd.mm = 30, 0 ))" ," class(res) <- \"segments\"; res" ,"}" ,"pic.plot(cars, " ," grp.color = 1, " ," grp.pic = 2, " ," colors = c(\"red\", \"blue\", \"green\")," ," pics = c(circle.simple, cross.simple), " ," vars.to.factors = c(.5, .5)," ," pic.space.factor = 0," ," main = \"icons constructed by circle generator functions\", " ,")" ,"#:80" ,"#82:" ,"mazz.man <- function(Mean = 100, expo = 1/(1:3)[3], Mean.max = 107, Mean.half = 90," ," Penalty = 1, Penalty.max = 5, Penalty.min = 0, plot = FALSE){ " ," # compute factor of traveller man" ," Mean.min <- Mean.half - (Mean.max - Mean.half) / ((h <- 2^(1/expo)) - 1)" ," Mean.min <- min(Mean.min, Mean)" ," fac <- 0.95 * ((h * (Mean - Mean.min)) / Mean.max) ^ expo" ," bag.size <- 0.80 * ((Penalty - Penalty.min) / Penalty.max )^expo /2" ," res <- rbind(c(5, 7.75*fac + .5, 5, 7.75*fac + .5), #head" ," c(5, 3.5 *fac + .5, 5, 6 *fac + .5), #body" ," c(5, 3.2 *fac + .5, 5, 0 *fac + .5), #leg in white" ," c(5, 3.2 *fac + .5, 5, 0 *fac + .5), #leg" ," c(5 + 3*fac, 5.5 *fac + .5, 5 + 2.5*fac, 7.5 *fac + .5), #tape2" ," c(5 - 2*fac, 6.5 *fac + .5, 5 + 3 *fac, 7 *fac + .5), #stick" ," c(5, 6.4 *fac + .5, 5 - 1.5*fac, 4.5 *fac + .5), #arm one" ," c(5 - 2*fac, 6.5 *fac + .5, 5 - 1.5*fac, 4.5 *fac + .5), #arm" ," c(5 + 2.75*fac, 5 *fac + .5 - 2*bag.size ," ," 5 + 2.75*fac, 5 *fac + .5 - 2*bag.size), #bag" ," c(5 + 2.5*fac, 5.5 *fac + .5, 5 + 3 *fac, 7.5 *fac + .5)) #tape1" ," lwd.mm <- c( c(17, 14, 12, 10, 2.5, 2, 6, 6) * fac / 0.927042" ," , 31 * bag.size / 0.2924, 2.5 * fac / 0.927042 ) " ," colors <- c(\"#3377BB\", \"white\", \"brown\", \"orange\")[c(1,1,2,1,4,3,1,1,4,4)]" ," if( plot ){" ," dev.fac <- 1; mm.to.lwd <- function(lwd.mm) lwd.mm * 3.787878 * dev.fac " ," par(pin = c(10, 10) / 2.54); plot(1, type = \"n\", axes = FALSE); " ," par(usr = c(0,10,0,10)); axis(1); axis(2)" ," title(paste(\"Penalty\", Penalty, \"Mean\", Mean))" ," segments(res[,1], res[,2], res[,3], res[,4], lwd = mm.to.lwd(lwd.mm), col = colors)" ," }" ," res <- cbind(data.frame(res, lwd.mm = lwd.mm, colors))" ," class(res) <- c(class(res), \"segments\"); res" ,"} " ,"mazz.man(plot = TRUE)" ,"#:82" ,"#85:" ,"smiley <- function(smile = 0, plot = FALSE){" ," circle <- function(x0 = 1, y0 = 1, a = 3, lwd = 5, " ," time.0 = 0, time.1 = 12, n = 60){" ," alpha <- seq(time.0, time.1, length = n); alpha <- alpha * (2*pi/12)" ," x <- a * sin(alpha) + x0; y <- a * cos(alpha) + y0" ," cbind(x[-n],y[-n], x[-1],y[-1], lwd)" ," }" ," res <- NULL" ," res <- rbind( res, cbind(5, 5, 5, 5, 100, 1 )) # face+rand" ," res <- rbind( res, cbind(5, 5, 5, 5, 88, NA)) # face " ," res <- rbind( res, cbind(circle(3.5,6.05,.30, 10), 1) ) # eye" ," res <- rbind( res, cbind(circle(6.5,6.05,.30, 10), 1) ) # eye " ," if(is.na(smile)){" ," res <- rbind( res, cbind(circle(5,5, 2.7, 7.5, 7.50, 4.50),1) ) # mouse" ," } else {" ," # x0 y0 a lwd time.0 time.1" ," hs <- circle( 5, 4, 1.7, 10, 8.5, 3.5) # mouse laughing" ," hn <- circle( 5, 2, 1.7, 10, 9.5, 14.5) # mouse not laughing " ," s <- smile; n <- 1-s" ," h <- cbind( hs[,1], s*hs[,2]+n*hn[,2], hs[,3], s*hs[,4]+n*hn[,4], hs[,5])" ," res <- rbind( res, cbind(h, 1) ) # mouse" ," }" ," class(res) <- \"segments\"" ," if(plot){" ," plot(1, type = \"n\", axes = FALSE); par(usr = c(0,10,0,10)) # ; axis(1); axis(2)" ," plot.dim.fac <- par()$pin[1] * 2.54 / 10; dev.fac <- 1 " ," mm.to.lwd <- function(lwd.mm) lwd.mm * 3.787878 * dev.fac * plot.dim.fac " ," col <- ifelse( is.na(res[,6]), \"green\", res[,6])" ," segments(res[,1], res[,2], res[,3], res[,4], lwd = mm.to.lwd(res[,5]), col = col )" ," text(0, 0, as.character(round(smile,2)), xpd = NA, cex = 1.5, adj = c(0,0) )" ," }" ," return(res)" ,"}" ,"oldpar <- par(mfrow = c(5,5), mar = c(0,0,0,0))" ,"for(smile in seq(0,1, length = 25)){" ," smiley(smile, TRUE)" ,"}; par(oldpar) " ,"#:85" ,"#89:" ,"p.set <- c(\"m2.pnm\", \"f2.pnm\")" ,"data <- margin.table(Titanic/100, 2:4)" ,"result <- pic.plot(data, " ," grp.xy = Age ~ Sex," ," grp.color = Survived, " ," grp.pic = Sex, " ," colors = c(\"black\", \"green\")," ," pics = p.set, " ," vars.to.factors = c(2, 3, 6)," ," panel.prop.to.size = 0.7," ," panel.reverse.y = TRUE," ," pic.stack.type = \"s\"," ," pic.frame = FALSE," ," pic.space.factor = 0.05," ," lab.parallel = c(TRUE, TRUE, FALSE)," ," main = \"Sex, Age, Survived of Titanic data in 100\")" ,"coor <- result[[1]][,1:4]; counts <- result[[1]][,\"counts\"]" ,"old <- par(result$newpar)" ,"text(coor[,2], coor[,4], as.character(counts), cex = 3, adj = c(1,1))" ,"par(result$old)" ,"#:89" ,"#94:" ,"grp.plot(USJudgeRatings, " ," grp.xy = 2 + 3 ~ 1, " ," vars.to.factors = c(.5, .5, .5)," ," panel.space.factor = 0.05, " ," packer = \"xy.plot\"," ," panel.x = \"DILG\", " ," panel.y = \"CFMG\", " ," panel.axes = c(\"lb\",\"rt\")[2]," ," panel.function = my.panel.function" ,")" ,"#:94" ,"#95:" ,"grp.plot(USJudgeRatings, " ," grp.xy = 2 ~ 1 + 3, " ," vars.to.factors = c(.5, .5, .5)," ," panel.space.factor = 0.05, " ," packer = \"boxplot\"," ," panel.x = \"DILG\", " ," panel.axes = c(\"lb\",\"rt\")[2]" ,")" ,"#:95" ,"#96:" ,"data <- rbind(trees,trees,trees,trees,trees,trees,trees,trees)" ,"pic.plot(data, vars.to.factors = c(10, .33, .33), " ," grp.xy = Volume ~ Height, " ," grp.color = Girth, " ," grp.pic = 0, " ," pics = \"fir.tree\"," ," colors = rainbow(10, start = .1, end = .45)," ," lab.legend = \"vertical\", pic.space.factor = 0, lab.cex = 0.9, " ," main = \"use of internal pictogram 'fir.tree'\")" ,"#:96" ,"#97:" ,"data <- rbind(trees,trees,trees)" ,"w <- data$Volume^(1/3); w <- w/max(w)" ,"data <- cbind(data, Width = w)" ,"pic.plot(data, vars.to.factors = c(10, .33, .33, FALSE), " ," grp.xy = Volume ~ Height, " ," grp.color = Girth, " ," grp.pic = 0 | Width, " ," pics = \"fir.tree\"," ," colors = rainbow(10, start = .1, end = .45)," ," lab.legend = \"vertical\", pic.space.factor = 0, lab.cex = 0.9, " ," main = \"internal pictogram 'fir.tree', different widths\")" ,"#:97" ,"#98:" ,"data <- rbind(trees,trees,trees)" ,"w <- data$Volume^(1/3); w <- w/max(w)" ,"s <- data$Height; s <- s - min(s); s <- s/max(s); s <- (s + 1)/2" ,"data <- cbind(data, Width = w, Size = s)" ,"pic.plot(data, vars.to.factors = c(10, .33, .33, FALSE, FALSE), " ," grp.xy = Volume ~ Height, " ," grp.color = Girth, " ," grp.pic = 0 | Width + Size, " ," pics = \"fir.tree\"," ," colors = rainbow(10, start = .1, end = .45)," ," lab.legend = \"vertical\", pic.space.factor = 0, lab.cex = 0.9, " ," main = \"internal pictogram 'fir.tree', different widths\")" ,"#:98" ,"#99:" ,"data <- rbind(trees,trees,trees)" ,"pic.plot(data, vars.to.factors = c(.05, .25, .25), " ," grp.xy = Volume ~ Height, " ," grp.color = Girth, " ," grp.pic = 0 | Girth, " ," pics = \"smiley\"," ," colors = rainbow(20, start = .1, end = .45)," ," pic.frame = FALSE," ," panel.frame = FALSE," ," lab.legend = \"vertical\", pic.space.factor = 0.1, lab.cex = 0.9, " ," main = \"internal pictogram 'smiley', smile depends on Girth\")" ,"#:99" ,"#100:" ,"data <- rbind(trees, trees, trees)" ,"s <- data$Girth; s <- s - min(s); s <- s/max(s); s <- (s + 1)/2" ,"data <- cbind(data, color.by.girth = data[,\"Girth\"], fraction.1 = s) " ,"pic.plot(data, vars.to.factors = c(.33, .33, .33, 10), " ," grp.xy = Volume ~ Height, " ," grp.color = color.by.girth, " ," grp.pic = Girth, " ," pics = c(\"bike\", \"heart\", \"bike2\")," ," colors = rainbow(10, start = .1, end = .40)," ," pic.frame = FALSE," ," lab.legend = \"vertical\", pic.space.factor = 0, lab.cex = 0.9, " ," main = \"pics: heart, bike, bike2; size by Girth\")" ,"#:100" ,"#101:" ,"pic.plot(trees, " ," grp.xy = 2 ~ 1," ," grp.color = 3, " ," vars.to.factor = c(0.333, 0.25, 0.2)," ," main = \"grouping by x and y, and by colors\")" ,"#:101" ,"#102:" ,"pic.plot(trees, " ," grp.xy = 2 ~ 1," ," grp.color = 3, " ," vars.to.factor = c(0.333, 0.25, 0.2)," ," lab.legend = \"cols\"," ," main = \"grouping by x and y, and by colors\")" ,"#:102" ,"#103:" ,"pic.plot(trees, " ," grp.xy = 2 ~ 1," ," grp.color = 3, " ," vars.to.factor = c(0.333, 0.25, 0.05)," ," lab.legend = \"skewed\"," ," main = \"grouping by x and y, and by colors\")" ,"#:103" ,"#104:" ,"pic.plot(trees, " ," grp.xy = 2 ~ 1," ," grp.color = 3, " ," vars.to.factor = c(0.333, 0.25, 0.05)," ," lab.legend = \"skewed\"," ," lab.cex = 0.7," ," main = \"grouping by x and y, and by colors\")" ,"#:104" ,"#105:" ,"pic.plot(trees, " ," grp.xy = 2 ~ 1," ," grp.color = 3, " ," vars.to.factor = c(0.333, 0.25, 0.05)," ," lab.legend = \"horizontal\"," ," main = \"grouping by x and y, and by colors\")" ,"#:105" ,"#106:" ,"pic.plot(trees, " ," grp.xy = 2 ~ 1," ," grp.color = 3, " ," vars.to.factor = c(0.333, 0.25, 0.03)," ," lab.legend = \"horizontal\"," ," lab.n.max = c(15, 2, 33)," ," main = \"grouping by x and y, and by colors\")" ,"#:106" ,"#107:" ,"pic.plot(trees, " ," grp.xy = 2 ~ 1," ," grp.color = 3, " ," vars.to.factor = c(0.333, 0.25, 0.05)," ," lab.legend = \"vertical\"," ," main = \"grouping by x and y, and by colors\")" ,"#:107" ,"#108:" ,"pic.plot(trees, " ," grp.xy = 2 ~ 1," ," grp.pic = 3, " ," vars.to.factor = c(0.333, 0.25, 0.05)," ," panel.frame = FALSE," ," pic.frame = FALSE," ," lab.legend = \"vertical\"," ," main = \"grouping by x and y, and by pictograms\")" ,"#:108" ,"#109:" ,"pic.plot(trees, " ," grp.xy = 2 ~ 1," ," grp.color = 3, " ," grp.pic = 2, " ," pics = 15:18," ," pic.frame = FALSE," ," vars.to.factor = c(0.333, 0.25, 0.2)," ," lab.legend = \"rows\"," ," main = \"grouping by x and y, and by colors and pics\")" ,"#:109" ,"#110:" ,"pic.plot(trees, " ," grp.xy = 2 ~ 1," ," grp.color = 3, " ," grp.pic = 2, " ," pics = 15:18," ," pic.frame = FALSE," ," vars.to.factor = c(0.333, 0.25, 0.2)," ," lab.legend = \"cols\"," ," main = \"grouping by x and y, and by colors and pics\")" ,"#:110" ,"#111:" ,"pic.plot(trees, " ," grp.xy = 2 ~ 1," ," grp.color = 3, " ," grp.pic = 2, " ," pics = 15:18," ," pic.frame = FALSE," ," vars.to.factor = c(0.333, 0.25, 0.05)," ," lab.legend = \"skewed\"," ," lab.cex = 0.7," ," main = \"grouping by x and y, and by colors and pics\")" ,"#:111" ,"#112:" ,"pic.plot(trees, " ," grp.xy = 2 ~ 1," ," grp.color = 3, " ," grp.pic = 2, " ," pics = 15:18," ," pic.frame = FALSE," ," vars.to.factor = c(0.333, 0.25, 0.05)," ," lab.cex = 1," ," lab.legend = \"horizontal\"," ," main = \"grouping by x and y, and by colors and pics\")" ,"#:112" ,"#113:" ,"pic.plot(trees, " ," grp.xy = 2 ~ 1," ," grp.color = 3, " ," grp.pic = 2, " ," pics = 15:18," ," pic.frame = FALSE," ," vars.to.factor = c(0.333, 0.25, 0.05)," ," lab.cex = 1," ," lab.legend = \"vertical\"," ," main = \"grouping by x and y, and by colors and pics\")" ,"#:113" ,"##:fig=TRUE,results=hide##" ,"##fig=FALSE,results=hide:##" ,"#9:" ,"pic.plot(data = 148, " ," pic.aspect = 0.25, " ," pic.space.factor = c(0, 0.4), " ," colors = \"blue\"," ," main = \"frequency, asp-ratio = 0.25, 0.4 pic space in y, 0.0 in x\")" ,"#:9" ,"#12:" ,"pic.plot(data = 148, " ," pic.aspect = 4, " ," pic.space.factor = c(0.2, 0.0), " ," colors = \"green\"," ," pic.frame = FALSE," ," main = \"horizontal pic space: 0.2, vertical pic space: 0.0," ," asp-ratio = 4, no pic frames \")" ,"#:12" ,"##:fig=FALSE,results=hide##" ,"##fig=TRUE,results=hide,echo=FALSE:##" ,"#10:" ,"pic.plot(data = 148, " ," pic.aspect = 0.25, " ," pic.space.factor = c(0, 0.4), " ," colors = \"blue\"," ," main = \"frequency, asp-ratio = 0.25, 0.4 pic space in y, 0.0 in x\")" ,"#:10" ,"#11:" ,"pic.plot(data = 148, " ," pic.aspect = 4, " ," pic.space.factor = c(0.2, 0.0), " ," colors = \"green\"," ," pic.frame = FALSE," ," main = \"horizontal pic space: 0.2, vertical pic space: 0.0," ," asp-ratio = 4, no pic frames \")" ,"#:11" ,"##:fig=TRUE,results=hide,echo=FALSE##" ,"##fig=FALSE,echo=FALSE,results=verbatim:##" ,"#49:" ,"dimnames(Titanic)" ,"#:49" ,"##:fig=FALSE,echo=FALSE,results=verbatim##" ,"##results=hide:##" ,"#60:" ,"mw <- c(350, 351, 345, 354, 349, 358, 358, 352, 356, 366, 366, 373, " ," 383, 399, 401, 409, 423, 417, 408, 419, 437, 446, 468, 519, 516, " ," 534, 526, 518, 501, 501, 503, 515, 509, 510, 487, 482, 479, 469, " ," 458, 463, 468, 511, 565, 587, 634, 665, 684, 705, 709, 722, 716, " ," 691, 679, 655, 637, 600, 585, 566, 545, 529, 509, 506, 495, 492, " ," 475, 433, 403, 348, 300, 399, 402, 385, 458, 471, 452, 410, 369, " ," 342, 314, 276, 208, 192, 180, 172, 151, 133, 106, 86, 69, 50, " ," 39, 33, 26, 19, 10, 5, 3, 2, 2, 2, 333, 333, 328, 337, 331, 341, " ," 339, 333, 338, 347, 348, 354, 362, 379, 379, 389, 401, 394, 385, " ," 395, 416, 427, 447, 494, 493, 508, 500, 496, 481, 482, 487, 500, " ," 500, 503, 480, 474, 471, 464, 451, 459, 464, 504, 555, 577, 619, " ," 649, 668, 687, 688, 703, 699, 679, 672, 650, 633, 598, 586, 571, " ," 557, 551, 535, 534, 523, 522, 503, 458, 431, 376, 333, 442, 447, " ," 432, 526, 552, 541, 498, 460, 439, 415, 376, 294, 284, 279, 281, " ," 258, 239, 211, 194, 176, 147, 124, 107, 91, 71, 42, 20, 14, 11, 10, 9) " ,"mw <- as.table(matrix(mw, ncol = 2,)/10)" ,"dimnames(mw) <- list(Age = as.character((1:nrow(mw))-1), Sex = c(\"M\",\"F\"))" ,"#:60" ,"#69:" ,"# get file some files" ,"# This chunk loads the graphics files \"R.pnm\", \"tm.pnm\", \"m2.pnm\" and \"f2.pnm\"" ,"# and the data set \"goettingen-niedersachs\" via internet into the R environment. " ,"# If you forget to activate these statements some of the following chunks don't work!!!" ,"url <- \"http://www.wiwi.uni-bielefeld.de/lehrbereiche/statoekoinf/comet/wolf/pw_files/files/\"" ,"tmp.pic <- readBin(paste(sep=\"\", url, \"R.pnm\"), what=\"raw\", n=51315); writeBin(tmp.pic, \"R.pnm\")" ,"tmp.pic <- readBin(paste(sep=\"\", url, \"m2.pnm\"), what=\"raw\", n=89435); writeBin(tmp.pic, \"m2.pnm\")" ,"tmp.pic <- readBin(paste(sep=\"\", url, \"f2.pnm\"), what=\"raw\", n=83393); writeBin(tmp.pic, \"f2.pnm\")" ,"tmp.pic <- readBin(paste(sep=\"\", url, \"tm.pnm\"), what=\"raw\", n=22514); writeBin(tmp.pic, \"tm.pnm\")" ,"source(paste(sep=\"/\", url, \"goettingen-niedersachs.R\")); require(tcltk)" ,"#:69" ,"#83:" ,"mazz.man.gen <- function(data.row = NULL){" ," if(0 < length(data.row)){" ," idx <- as.numeric(rownames(data.row)) " ," text(data.row$x0, data.row$y0, data.row$Region, cex = 0.5, adj = c(0,1))" ," mazz.man(Mean = data.row$Mean, Penalty = data.row$Penalty)" ," } else { mazz.man() }" ,"}" ,"Mazziotta.Pareto <- " ," structure(list(Region = c(\"Piemonte\", \"Valle d'Aosta\", \"Lombardia\", " ," \"Trentino-Alto Adige\", \"Veneto\", \"Friuli-Venezia Giulia\", \"Liguria\", " ," \"Emilia-Romagna\", \"Toscana\", \"Umbria\", \"Marche\", \"Lazio\", \"Abruzzo\", " ," \"Molise\", \"Campania\", \"Puglia\", \"Basilicata\", \"Calabria\", \"Sicilia\", " ," \"Sardegna\"), Mean = c(98.74, 104.07, 101.38, 106.1, 104.38, 105.55, " ," 102.76, 103.62, 101.84, 103.52, 102.05, 97.88, 102.9, 91.43, " ," 94.12, 96.78, 93.55, 92.59, 96.29, 100.45), Penalty = c(0.43, " ," 4.23, 0.64, 0.63, 0.77, 0.34, 0.29, 0.46, 0.27, 0.22, 0.15, 0.82, " ," 1.3, 1.02, 0.37, 0.21, 2.37, 0.51, 0.31, 0.76), MPI = c(98.3, " ," 99.84, 100.74, 105.47, 103.61, 105.21, 102.47, 103.16, 101.57, " ," 103.3, 101.9, 97.06, 101.6, 90.42, 93.75, 96.58, 91.18, 92.08, " ," 95.98, 99.69)), .Names = c(\"Region\", \"Mean\", \"Penalty\", \"MPI\" " ," ), row.names = c(NA, -20L), class = \"data.frame\")" ,"dm <- Mazziotta.Pareto" ,"dm <- cbind(dm, fraction.1 = dm[, \"Mean\"] / max(dm[, \"Mean\"]), " ," col = as.factor(rep(1:5,4)), # as.factor!! " ," row = as.factor(rep(1:4, each = 5))) # as.factor!!" ,"#:83" ,"#87:" ,"generate.fns <- function(set.of.faces, i.set = 16){" ," a <- set.of.faces[[1]]; f.list <- NULL" ," for(i in i.set){ " ," ai <- a[[i]]; b <- NULL" ," for(k in seq(along=ai)){ " ," b <- rbind(b, cbind( ai[[k]][ -dim(ai[[k]])[1],, drop=FALSE ], " ," ai[[k]][ -1,, drop=FALSE ], 8, NA))" ," }" ," b[, 1:4] <- b[, 1:4]/15; b[, c(1,3)] <- b[, c(1,3)] + 10" ," class(b) <- \"segments\"" ," fname <- paste(sep = \"\", \"f\", i)" ," f <- eval(parse(text = c(paste(fname, \"<- function()\"), deparse(b))))" ," f.list <- c(f.list, f)" ," }" ," f.list" ,"}" ,"#:87" ,"##:results=hide##" ,"##echo = FALSE, results=verbatim:##" ,"#76:" ,"margin.table(data, 2:1)" ,"#:76" ,"#81:" ,"Mazziotta.Pareto <- " ," structure(list(Region = c(\"Piemonte\", \"Valle d'Aosta\", \"Lombardia\", " ," \"Trentino-Alto Adige\", \"Veneto\", \"Friuli-Venezia Giulia\", \"Liguria\", " ," \"Emilia-Romagna\", \"Toscana\", \"Umbria\", \"Marche\", \"Lazio\", \"Abruzzo\", " ," \"Molise\", \"Campania\", \"Puglia\", \"Basilicata\", \"Calabria\", \"Sicilia\", " ," \"Sardegna\"), Mean = c(98.74, 104.07, 101.38, 106.1, 104.38, 105.55, " ," 102.76, 103.62, 101.84, 103.52, 102.05, 97.88, 102.9, 91.43, " ," 94.12, 96.78, 93.55, 92.59, 96.29, 100.45), Penalty = c(0.43, " ," 4.23, 0.64, 0.63, 0.77, 0.34, 0.29, 0.46, 0.27, 0.22, 0.15, 0.82, " ," 1.3, 1.02, 0.37, 0.21, 2.37, 0.51, 0.31, 0.76), MPI = c(98.3, " ," 99.84, 100.74, 105.47, 103.61, 105.21, 102.47, 103.16, 101.57, " ," 103.3, 101.9, 97.06, 101.6, 90.42, 93.75, 96.58, 91.18, 92.08, " ," 95.98, 99.69)), .Names = c(\"Region\", \"Mean\", \"Penalty\", \"MPI\" " ," ), row.names = c(NA, -20L), class = \"data.frame\")" ,"Mazziotta.Pareto" ,"#:81" ,"##:echo = FALSE, results=verbatim##" ,"##fig=TRUE, results=hide:##" ,"#84:" ,"pic.plot(dm, " ," grp.xy = row ~ col," ," grp.pic = 0 | Mean + Penalty + Region, " ," vars.to.factor = FALSE," ," pics = mazz.man.gen, " ," pic.space.factor = 0," ," pic.frame = FALSE," ," panel.reverse.y = TRUE," ," lab.parallel = TRUE, " ," lab.side = c(\"\",\"\")," ," main = \"Traveller plot\")" ,"#:84" ,"#86:" ,"smiley.gen <- function(data.row = NULL){" ," if(0 < length(data.row)){" ," idx <- as.numeric(data.row[\"idx\"])" ," h <- min(trees[, \"Volume\"])" ," smile <- (trees[idx, \"Volume\"] - h)/" ," (max(trees[ , \"Volume\"]) - h)" ," res <- smiley(smile = smile)" ," } else { res <- smiley() }" ," return(res)" ,"}" ,"pic.plot(trees, " ," grp.xy = Height ~ Girth," ," grp.pic = Volume, " ," grp.color = Volume," ," vars.to.factor = c(.25, .3, .05), " ," pics = smiley.gen, " ," pic.space.factor = 0.1," ," pic.frame = FALSE," ," panel.frame = FALSE," ," main = \"smileys represent trees\")" ,"#:86" ,"#88:" ,"library(aplpack, lib.loc = \"~/lib\")" ,"faces.of.trees <- faces(trees, plot.faces = FALSE)" ,"f.list <- generate.fns(faces.of.trees, 1:31)" ,"pic.plot(trees, " ," grp.pic = 3, " ," grp.col = 3, " ," vars.to.factors = c(.25, .3, .12), " ," pics = f.list," ," pic.space.factor = 0.3, " ," pic.frame = FALSE," ," panel.frame = FALSE," ," lab.cex = 0.7, " ," lab.parallel = c(TRUE, TRUE, FALSE)," ," main = \"trees by faces and pic.plot\")" ,"#:88" ,"##:fig=TRUE, results=hide##" ,"##results=verbatim,fig=TRUE:##" ,"#90:" ,"p.set <- c(\"m2.pnm\", \"f2.pnm\")" ,"data <- margin.table(Titanic/100, 2:4)" ,"result <- pic.plot(data, " ," grp.xy = Age ~ Sex," ," grp.color = \"Survived\", " ," grp.pic = \"Sex\", " ," colors = c(\"black\", \"green\")," ," pics = p.set, " ," vars.to.factors = c(2, 3, 6)," ," panel.prop.to.size = 0.7," ," panel.reverse.y = TRUE," ," pic.stack.type = \"s\"," ," pic.frame = FALSE," ," pic.space.factor = 0.05," ," lab.parallel = c(TRUE, TRUE, FALSE)," ," main = \"Sex, Age, Survived of Titanic in 100\")" ,"coor <- result[[1]][,1:4]; counts <- result[[1]][,\"counts\"]" ,"old <- par(result$newpar)" ,"text(coor[,2], coor[,4], as.character(counts), cex = 1, adj = c(1,1))" ,"dm <- result[[2]]" ,"no <- 100 * sapply(split(dm[,\"fraction.1\"], dm[,\"job.no\"]), sum)" ,"idx <- rank(result[[1]][,\"job.no\"])" ,"text(coor[idx, 1], coor[idx, 4], paste(\"persons\", no), " ," cex = 1, adj = c(0,1), col = \"blue\")" ,"par(result$old); margin.table(Titanic, c(3:2))" ,"#:90" ,"##:results=verbatim,fig=TRUE##" ,"##:##" ,"#92:" ,"my.panel.function <- function(){" ," if(0 == length(dm)) return()" ," xx <- dm[, panel.x]; yy <- dm[, panel.y]" ," points(xx, yy, col = \"green\", pch = 16, cex = 2)" ," if(length(xx) < 2) return()" ," abline(lm(yy ~ xx)$coef, col = \"red\", lwd = 4)" ,"}" ,"#:92" ,"##:##" ,"##results = verbatim:##" ,"#93:" ,"USJudgeRatings[1:5,]" ,"#:93" ,"##:results = verbatim##" ) if (start == TRUE) { no.0 <- "0" no.start.0 <- grep(paste("^#", no.0, ":$", sep = ""), chunks) no.end.0 <- grep(paste("^#:", no.0, "$", sep = ""), chunks) code.0 <- chunks[no.start.0:no.end.0] eval(parse(text = code.0), envir = where) } secno <- tclVar("1") show.next.number <- function(...) { no <- as.character(as.numeric(tclvalue(secno)) + 1) no.start <- grep(paste("^#", no, ":$", sep = ""), chunks) no.end <- grep(paste("^#:", no, "$", sep = ""), chunks) if (length(no.end) == 0 || is.na(no.end) || is.na(no.start) || is.nan(no.end) || is.nan(no.start)) { cat("# sorry, chunk number '", no, "' wrong!\n") return() } code <- paste(chunks[no.start:no.end], collapse = "\n") if (0 < length(code)) { tkdelete(ttext, "0.0", "end") tkinsert(ttext, "0.0", code) tclvalue(secno) <- as.character(no) } } show.back.number <- function(...) { no <- as.character(as.numeric(tclvalue(secno)) - 1) no.start <- grep(paste("^#", no, ":$", sep = ""), chunks) no.end <- grep(paste("^#:", no, "$", sep = ""), chunks) if (length(no.end) == 0 || is.na(no.end) || is.na(no.start) || is.nan(no.end) || is.nan(no.start)) { cat("# sorry, chunk number '", no, "' wrong!\n") return() } code <- paste(chunks[no.start:no.end], collapse = "\n") if (0 < length(code)) { tkdelete(ttext, "0.0", "end") tkinsert(ttext, "0.0", code) tclvalue(secno) <- as.character(no) } } show.number <- function(...) { no <- as.character(as.numeric(tclvalue(secno))) no.start <- grep(paste("^#", no, ":$", sep = ""), chunks) no.end <- grep(paste("^#:", no, "$", sep = ""), chunks) if (length(no.end) == 0 || is.na(no.end) || is.na(no.start) || is.nan(no.end) || is.nan(no.start)) { cat("# sorry, chunk number '", no, "' wrong!\n") return() } code <- paste(chunks[no.start:no.end], collapse = "\n") if (0 < length(code)) { tkdelete(ttext, "0.0", "end") tkinsert(ttext, "0.0", code) tclvalue(secno) <- as.character(no) } } eval.code <- function(...) { code <- tclvalue(tkget(ttext, "0.0", "end")) code.orig <- code <- unlist(strsplit(code, "\n")) code <- code[!substring(code, 1, 1) == "#"] if (length(code) == 0) { cat("ok\n") return() } result <- try(eval(parse(text = code), envir = where)) code.orig <- sub("#([0-9]+):", "##wnt-Code-Chunk:\\1-begin#", code.orig) code.orig <- sub("#:([0-9]+)", "##wnt-Code-Chunk:\\1-end#", code.orig) h <- get("allcodechunks", envir = where) h <- c(h, paste("<", "<*>", ">=", sep = ""), code.orig, "\n@\n") assign("allcodechunks", h, envir = where) code <- sub("^ *", "", code) code <- code[nchar(code) > 0] lexpr <- rev(code)[1] lexpr <- substring(lexpr, 1, 4) if (length(code) == 0 || is.null(lexpr) || is.na(lexpr)) return() plot.res <- c("plot", "boxp", "par(", "abli", "pie(", "hist", "axis", "show", "lsfi", "pair", "ylab", "help", "qqli", "qqno", "qqpl", "rug(", "lege", "segm", "text", "xlab", "poin", "line", "titl", "eda(", "imag", "vgl.", "curv") if (any(plot.res == lexpr)) { cat("Plot generated\n") return() } if (is.null(result) || is.na(result) || lexpr == "prin" || lexpr == "cat(") { cat("ok\n") return() } if (is.list(result) && length(names(result)) > 0 && names(result)[1] == "ID") return() no <- as.character(as.numeric(tclvalue(secno))) cat("Result of code chunk", no, ":\n") if (class(result) == "try-error") { class(result) <- "character" cat(result, "\n") } else { print(result) } cat("ok\n") } exit.function <- function() { tkdestroy(top) filename <- tkgetSaveFile(filetypes = "{{Paper Files} {.rev}}", title = "Do you want to save the activated R statements?") if (!is.character(filename)) filename <- tclvalue(filename) if (filename == "") { cat("Demo function stopped without saving\n") return() } if (0 == length(grep("rev$", filename))) filename <- paste(filename, ".rev", sep = "") h <- get("allcodechunks", envir = where) try(cat(h, sep = "\n", file = filename)) cat(paste("Remark: activated statements saved in\n ", filename, "\n")) return() } allcodechunks <- paste("@\nReport of activated R-chunks from: ", date(), "\n(demo function constructed by relax (c) Peter Wolf 2014)\n\n ", sep = "") no <- 0 no.start <- grep(paste("^#", no, ":$", sep = ""), chunks) no.end <- grep(paste("^#:", no, "$", sep = ""), chunks) if (length(no.end) == 0 || is.na(no.end) || is.na(no.start) || is.nan(no.end) || is.nan(no.start)) { cat("# sorry, chunk number '", no, "' wrong!\n") return() } code <- paste(chunks[no.start:no.end], collapse = "\n") h <- paste(rep("#", 60), collapse = "") code <- sub("#0:", h, code) code <- sub("#:0", h, code) allcodechunks <- c(allcodechunks, "\n@\n<>=", code, "\n@") assign("allcodechunks", allcodechunks, envir = where) top <- tktoplevel() ttext <- tktext(top, height = 19, background = "#f7fffF", font = "-Adobe-courier-Medium-R-Normal--18-180-*") tf <- tkframe(top) tkwm.title(top, "demo of file examples-new.R, constructed by relax (c) Peter Wolf 2014") tkpack(tf, side = "bottom") tkpack(tf, ttext, side = "bottom", fill = "both", expand = "y") tkevent.add("<>", "") if (substring(version$os, 1, 6) == "darwin") { mac.paste <- function(...) { try({ .Tcl("clipboard append hello") .Tcl("clipboard clear") news <- base::scan(file = pipe("pbpaste", "r"), what = "", sep = "\n", blank.lines.skip = FALSE) tkinsert(ttext, "insert", paste(news, collapse = "\n")) }) tksee(ttext, "insert - 7 lines") tksee(ttext, "insert + 7 lines") } tkbind(ttext, "", mac.paste) mac.copy <- function(...) { news <- "" try(news <- tclvalue(.Tcl("if {[catch {clipboard get}]} {set aa empty} {set aa full}"))) if (news == "empty") return() try({ news <- tclvalue(.Tcl("set aaa [selection get -selection CLIPBOARD]")) tmp.file.name <- tempfile("rt-tmp") base::cat(news, file = tmp.file.name) system(paste("pbcopy < ", tmp.file.name)) .Tcl("clipboard append hello") .Tcl("clipboard clear") }) } tkbind(ttext, "", mac.copy) tkevent.add("<>", "") tkbind(ttext, "<>", mac.copy) } else { tkevent.add("<>", "") tkbind(ttext, "<> { catch {%W insert insert [selection get -selection CLIPBOARD] } }") } bexit <- tkbutton(tf, text = "QUIT", width = 9) beval <- tkbutton(tf, text = "EVALUATE", width = 9) bnext <- tkbutton(tf, text = "NEXT", width = 9) bback <- tkbutton(tf, text = "BACK", width = 9) tkbind(top, "<>", eval.code) if (!substring(version$os, 1, 6) == "darwin") { tkbind(top, "<>", show.next.number) tkbind(top, "<>", show.back.number) } lno <- tkentry(tf, textvariable = secno, width = 9) linfo <- tklabel(tf, text = "chunk number:") tkpack(linfo, lno, beval, bnext, bback, bexit, side = "left") tkconfigure(bexit, command = exit.function) tkconfigure(bnext, command = show.next.number) tkconfigure(bback, command = show.back.number) tkconfigure(beval, command = eval.code) tkbind(lno, "", show.number) tclvalue(secno) <- as.character(no) show.number() } cat("Demo will be started by > examplesnewdemo()\n") examplesnewdemo()