In rwoldford/glyphs: Make glyphs using pixel-oriented data visualization technique
illustrates
library(glyphs)
library(jpeg)
- Mapping from data values to colors
- Layout of colors in a 2-D plane
- Make a list of glyphs from a multidimensional data
- Plot glyphs in a device
data2col
The data2col function provides a mapping from data values to colors. Given a data vector, data2col function can generate a corresponding colors vector. It uses the hsi colorspace provided by Keim. [@keim1995issues] This colorspace is unlike the hsv and hls. It preserves the monotonicity when color scales are mapped to gray-scale, which means higher data values will have higher gray-scale. The color scale given below for the hsi color is also our default setting in the data2col function.
x <- c(0, 360)
y <- c(0.4, 1)
f <- approxfun(x, y)
l <- 100000
H <- seq(x[1],x[2], length.out = l)
I <- f(H)
S <- rep(1,length(H))
R <- hsi2rgb(H, S, I)[1,]
G <- hsi2rgb(H, S ,I)[2,]
B <- hsi2rgb(H, S, I)[3,]
col_hsi <- rgb(R, G, B, maxColorValue = 255)
gr1 <- (0.34*R + 0.5*G + 0.16*B)/255
grey_hsi <- grey(gr1)
col_hsv <- hsv(H/360, S, I)
hsv_rgb <- col2rgb(col_hsv)
gr2 <- (0.34 * hsv_rgb[1,] + 0.5 * hsv_rgb[2,] + 0.16 * hsv_rgb[3,]) / 255
grey_hsv <- grey(gr2)
par(mfrow=c(2,1), mar = rep(2,4))
barplot(rep(1,length(H)), col = col_hsi, border = NA, beside = FALSE, space = c(0,0),
axes = FALSE, main="HSI color mapping", cex.main = 0.9)
barplot(rep(1,length(H)), col = grey_hsi, border = NA, beside = FALSE, space = c(0,0),
axes = FALSE)
barplot(rep(1,length(H)), col = col_hsv, border = NA, beside = FALSE, space = c(0,0),
axes = FALSE, main="HSV color mapping", cex.main = 0.9)
barplot(rep(1,length(H)), col = grey_hsv, border = NA, beside = FALSE, space = c(0,0),
axes = FALSE)
Below is an illustration for standard normal data.
par(mar = rep(1.5,4))
set.seed(100)
cols <- data2col(rnorm(30))
barplot(rep(1,length(cols)), col = cols, border = NA, beside = FALSE, space = c(0,0),
axes = FALSE, main="Standard normal data", cex.main = 0.8)
Color layout function
Next, we will consider displaying the colors in a specific order in a 2-D plane. "Hilbert curve", "Morton curve" and one method suggested by "rectangle" are provided corresponding to the three functions HilbertGlyph, MortonGlyph, and recGlyph. [@keim1996pixel] Each function can give a png format matrix or a class of pixmap which can be considered as a glyph. The glyph can also be treated as a basic element to plot.
Hilbert <- function(x = 0,y= 0,level, drawFn, col,Repeat = FALSE, plot = TRUE, ...){
if (plot) {
plot(0,type='n', xlim=c(0, x+2^level), ylim=c(0,y+2^level),axes = FALSE,xlab = "", ylab = "", ...)
}
maxLength <- 2^(2*level)
y <- 2^level
if(missing(col)) col <- rainbow(maxLength)
if (Repeat){
if(length(col) != maxLength) {
col <- rep_len(col, length.out = maxLength)
}
}
if(missing(drawFn)) {
drawFn <- function(x,y, num, col) {
rect(x,y-1,x+1,y,col = col)
points(x+1/2, y-1/2, pch=paste(num%%10), cex = 0.8)
}
}
locNum <- 1
SetLocImage <- function(x,y,col){
drawFn(x,y, locNum, col = col[locNum])
locNum <<- locNum + 1
}
move <- function(d){
switch(d,
down = {y <<- y-1
x <<- x},
up = {y <<- y+1
x <<- x},
right = {x <<- x+1
y <<- y},
left = {x <<- x-1
y <<- y}
)
}
if (level %% 2 == 1){
HilbertStep <- function(R,D,L,U,level, col){
if (level > 0){
HilbertStep(D,R,U,L,level-1, col)
SetLocImage(x,y,col)
move(R)
HilbertStep(R,D,L,U,level-1, col)
SetLocImage(x,y,col)
move(D)
HilbertStep(R,D,L,U,level-1, col)
SetLocImage(x,y,col)
move(L)
HilbertStep(U,L,D,R,level-1, col)
}
}
HilbertStep("right","down","left","up",level, col)
SetLocImage(x,y,col)
} else {
HilbertStep <- function(D,R,U,L,level, col){
if (level > 0){
HilbertStep(R,D,L,U,level-1, col)
SetLocImage(x,y,col)
move(R)
HilbertStep(D,R,U,L,level-1, col)
SetLocImage(x,y,col)
move(D)
HilbertStep(D,R,U,L,level-1, col)
SetLocImage(x,y,col)
move(L)
HilbertStep(L,U,R,D,level-1, col)
}
}
HilbertStep("right","down","left","up",level, col)
SetLocImage(x,y,col)
}
}
par(mfrow = c(2,3), mar = rep(1, 4))
Hilbert(level=1, main = "Hilbert curve(level=1)", cex.main = 0.8)
Hilbert(level=2, main = "Hilbert curve(level=2)", cex.main = 0.8)
Hilbert(level=3, main = "Hilbert curve(level=3)", cex.main = 0.8)
plot_matrix <- matrix(nrow = 2^(2*1), ncol = 2)
Hilbert(level=1, drawFn = function(x,y,locNum,col) {plot_matrix[locNum,] <<- c(x+0.5, y-0.5)}, plot = FALSE)
plot(data.frame(plot_matrix), type = "l", axes = FALSE, xlab = "", ylab = "")
plot_matrix <- matrix(nrow = 2^(2*2), ncol = 2)
Hilbert(level=2, drawFn = function(x,y,locNum,col) {plot_matrix[locNum,] <<- c(x+0.5, y-0.5)}, plot = FALSE)
plot(data.frame(plot_matrix), type = "l", axes = FALSE, xlab = "", ylab = "")
plot_matrix <- matrix(nrow = 2^(2*3), ncol = 2)
Hilbert(level=3, drawFn = function(x,y,locNum,col) {plot_matrix[locNum,] <<- c(x+0.5, y-0.5)}, plot = FALSE)
plot(data.frame(plot_matrix), type = "l", axes = FALSE, xlab = "", ylab = "")
Morton <- function(x=0,y=0,level,drawFn,col,Repeat = FALSE, plot = TRUE, ...){
if (plot) {
plot(0,type='n', xlim=c(0, x+2^level), ylim=c(0,y+2^level),axes = FALSE,xlab = "", ylab = "", ...)
}
maxLength <- 2^(2*level)
y <- 2^level
if(missing(col)) col <- rainbow(maxLength)
if (Repeat){
if(length(col) != maxLength) {
col <- rep_len(col, length.out = maxLength)
}
}
if(missing(drawFn)) {
drawFn <- function(x,y, num, col) {
rect(x,y-1,x+1,y,col = col)
points(x+1/2, y-1/2, pch=paste(num%%10), cex = 0.8)
}
}
locNum <- 1
SetLocImage <- function(x,y,col){
drawFn(x,y, locNum, col = col[locNum])
locNum <<- locNum + 1
}
MortonStep <- function(x,y,level,col){
if (level>1){
MortonStep(x,y,level-1,col)
MortonStep(x+2^(level-1),y,level-1,col)
MortonStep(x,y-2^(level-1),level-1,col)
MortonStep(x+2^(level-1),y-2^(level-1),level-1,col)
}
else{
SetLocImage(x,y,col)
SetLocImage(x <- x+1,y, col)
SetLocImage(x <- x-1,y <- y-1,col)
SetLocImage(x <- x+1, y,col)
}
}
MortonStep(x,y,level,col)
}
Morton(level = 1, main = "Morton Curve(level=1)", cex.main = 0.8)
Morton(level = 2, main = "Morton Curve(level=2)", cex.main = 0.8)
Morton(level = 3, main = "Morton Curve(level=3", cex.main = 0.8)
plot_matrix <- matrix(nrow = 2^(2*1), ncol = 2)
Morton(level=1, drawFn = function(x,y,locNum,col) {plot_matrix[locNum,] <<- c(x+0.5, y-0.5)}, plot = FALSE)
plot(data.frame(plot_matrix), type = "l", axes = FALSE, xlab = "", ylab = "")
plot_matrix <- matrix(nrow = 2^(2*2), ncol = 2)
Morton(level=2, drawFn = function(x,y,locNum,col) {plot_matrix[locNum,] <<- c(x+0.5, y-0.5)}, plot = FALSE)
plot(data.frame(plot_matrix), type = "l", axes = FALSE, xlab = "", ylab = "")
plot_matrix <- matrix(nrow = 2^(2*3), ncol = 2)
Morton(level=3, drawFn = function(x,y,locNum,col) {plot_matrix[locNum,] <<- c(x+0.5, y-0.5)}, plot = FALSE)
plot(data.frame(plot_matrix), type = "l", axes = FALSE, xlab = "", ylab = "")
RecP <- function(x=0,y=0,drawFn,width,height,col,Repeat = FALSE, plot = TRUE, ...){
if(missing(width)) width <- c(7,1,12)
if(missing(height)) height <- c(1,4,1)
if (plot) {
plot(c(0,prod(width)),c(0,prod(height)), type = "n", axes = FALSE, xlab = "", ylab = "", ...)
}
maxLength <- prod(width)*prod(height)
y <- prod(height)
if(missing(col)) col <- rainbow(maxLength)
if (Repeat){
if(length(col) != maxLength) {
col <- rep_len(col, length.out = maxLength)
}
}
if(missing(drawFn)) {
drawFn <- function(x,y, num, col) {
rect(x,y-1,x+1,y,col = col)
points(x+1/2, y-1/2, pch=paste(num%%10), cex = 0.8)
}
}
locNum <- 1
SetLocImage <- function(x,y,col){
drawFn(x,y, locNum, col = col[locNum])
locNum <<- locNum + 1
}
level <- length(height)
next_x <- numeric(level+1)
next_y <- numeric(level+1)
next_x[1] <- 1
next_y[1] <- 1
for(i in 2: (level+1)){
next_x[i] <- prod(width[1:(i-1)])
next_y[i] <- prod(height[1:(i-1)])
}
RecPStep <- function(x,y,level,col){
if (level == 0){
SetLocImage(x,y,col)
}
else {
if (level == 1){
for(h in 1:height[level]){
if (h%%2 == 1){
for(w in 1:width[level]){
RecPStep(x,y,level-1,col)
x <- x + next_x[level]
}
}
else {
for(w in 1:width[level]){
x <- x - next_x[level]
RecPStep(x,y,level-1,col)
}
}
y <- y - next_y[level]
}
}
else {
for(h in 1:height[level]){
for(w in 1:width[level]){
RecPStep(x,y,level-1,col)
x <- x + next_x[level]
}
x <- x - next_x[level+1]
y <- y - next_y[level]
}
}
}
}
RecPStep(x,y,level,col)
}
# example
RecP(width=3,height=3,Repeat = TRUE,
main = "Keim's rectangle plot with width(3) and height(3)", cex.main = 0.8)
RecP(width=c(3,2),height=c(3,2),Repeat = TRUE,
main = "Keim's rectangle plot with width(3,2) and height(3,2)", cex.main = 0.8)
RecP(width=c(3,2,2),height=c(3,2,2),Repeat = TRUE,
main = "Keim's rectangle plot with width(3,2,2) and height(3,2,2)", cex.main = 0.8)
plot_matrix <- matrix(nrow = 3*3, ncol = 2)
RecP(width=3,height=3, drawFn = function(x,y,locNum,col) {plot_matrix[locNum,] <<- c(x+0.5, y-0.5)}, plot = FALSE)
plot(data.frame(plot_matrix), type = "l", axes = FALSE, xlab = "", ylab = "")
plot_matrix <- matrix(nrow = (3*2)*(3*2), ncol = 2)
RecP(width=c(3,2),height=c(3,2), drawFn = function(x,y,locNum,col) {plot_matrix[locNum,] <<- c(x+0.5, y-0.5)}, plot = FALSE)
plot(data.frame(plot_matrix), type = "l", axes = FALSE, xlab = "", ylab = "")
plot_matrix <- matrix(nrow = (3*2*2)*(3*2*2), ncol = 2)
RecP(width=c(3,2,2),height=c(3,2,2), drawFn = function(x,y,locNum,col) {plot_matrix[locNum,] <<- c(x+0.5, y-0.5)}, plot = FALSE)
plot(data.frame(plot_matrix), type = "l", axes = FALSE, xlab = "", ylab = "")
One can see the order of each displaying method from the flow of the color, the number inside each square and the line graph shown in the right. Note that the plot starts from the top left corner and the sequence of numbers is module by 10.
For the Keim's rectangular method, the plot is drawn recursively and only the first level is in an "snake" order, and the rest start from the left end. This method can do better in the time series data, since the time order such as year, month and so on is in this recursive manner.
The illustration of some functions are shown below.
par(mar = rep(1.5,4))
cols <- rainbow(64) # get colors
myPngmat <- HilbertGlyph(cols) # get a glyph of data matrix in png format
plot(0,type='n', xlim=c(0,1), ylim=c(0,1), axes = FALSE, xlab = "", ylab = "",
main = "HilbertGlyph draw", cex.main = 0.9) # background plot
rasterImage(myPngmat,0,0,1,1) # plot the glyph
myPngmat <- MortonGlyph(cols)
plot(0,type='n', xlim=c(0,1), ylim=c(0,1), axes = FALSE, xlab = "", ylab = "",
main = "MortonGlyph draw", cex.main = 0.9)
rasterImage(myPngmat,0,0,1,1)
Make glyphs and plot them in a device
Then, for a multidimension data set, make_glyphs can get a list of glyphs from a list of data vectors. getGridXY provides x and y coordinates where we need to plot in a grid. Finally, plot_glyphs plots the glyphs in a specific device. Or one can use his own plot function to plot the glyphs generated by make_glyphs.
An illustration of student t distribution data plot is shown as follows. Also, we can choose the interested range that we want and lower value outside the range will be in blue while higher value will be in red.
par(mar = rep(1.5,4))
n <- 9
# data generated from student t distribution
data <- list()
for (i in 1:n){
data[[i]] <- rt(1000, df = 10)
}
glyphs <- make_glyphs(data,origin = "mean", type = "pixmap") # get glyphs in pixmap
x <- getGridXY(n) # get the x and y coordinates to plot
# plot glyphs
plot_glyphs(x, glyphs = glyphs, glyphWidth = 0.8, glyphHeight = 0.8, type = "pixmap",
axes = FALSE, xlab = "", ylab = "",
main = "A list of 9 student t data sets with df=10", cex.main = 0.8)
glyphs_outlier <- make_glyphs(data, type = "pixmap", xLow = -3, origin = 0, xHigh = 3)
plot_glyphs(x, glyphs = glyphs_outlier, glyphWidth = 0.8, glyphHeight = 0.8, type = "pixmap",
axes = FALSE, xlab = "", ylab = "",
main = "A list of 9 student t data sets with df=10\n with range (-3,3)",
cex.main = 0.8)
Finally, make_glyphs_draw is also a useful function which is more general. Given a list of data vectors, and any draw_fun, make_glyphs_draw can get a list of corresponding glyphs in almost all picture types. It can also be a tool to transform a list of glyphs between different picture forms.
Below shows an example of draw_fun=hist which is a built-in function in r.
par(mar = rep(1,4))
glyphs_hist <- make_glyphs_draw(data,
draw_fun = function(data_i){hist(data_i, main = "", axes = FALSE,
col = "steelblue")},
type = "png", mar = rep(1, 4), width = 100, height = 100)
x <- getGridXY(n)
plot_glyphs(x, glyphs = glyphs_hist, glyphWidth = 0.8, glyphHeight = 0.8,
axes = FALSE, xlab = "", ylab = "")
Then an example of transforming glyphs from "pixmap" to "jpeg"
par(mar = rep(1.5,4))
plot_glyphs(x, glyphs = glyphs, glyphWidth = 0.8, glyphHeight = 0.8, type = "pixmap", axes = FALSE, xlab = "", ylab = "", main = "A list of 9 student t data sets with df=10\n (pixmap)", cex.main = 0.7)
glyphs_jpeg <- make_glyphs_draw(data = glyphs,
draw_fun = function(data_i){
plot_glyphs(getGridXY(1),glyphs = list(data_i),
type = "pixmap",
axes = FALSE, xlab = "", ylab = "")
},
type = "jpeg", mar = rep(0, 4), width = 100, height = 100)
plot_glyphs(x, glyphs = glyphs_jpeg, glyphWidth = 0.8, glyphHeight = 0.8,
axes = FALSE, xlab = "", ylab = "",
main = "A list of 9 student t data sets with df=10 \n (jpeg)", cex.main = 0.7)
Reference
rwoldford/glyphs documentation built on Nov. 14, 2020, 2:29 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.
illustrates
library(glyphs) library(jpeg)
- Mapping from data values to colors
- Layout of colors in a 2-D plane
- Make a list of glyphs from a multidimensional data
- Plot glyphs in a device
data2col
The data2col function provides a mapping from data values to colors. Given a data vector, data2col function can generate a corresponding colors vector. It uses the hsi colorspace provided by Keim. [@keim1995issues] This colorspace is unlike the hsv and hls. It preserves the monotonicity when color scales are mapped to gray-scale, which means higher data values will have higher gray-scale. The color scale given below for the hsi color is also our default setting in the data2col function.
x <- c(0, 360) y <- c(0.4, 1) f <- approxfun(x, y) l <- 100000 H <- seq(x[1],x[2], length.out = l) I <- f(H) S <- rep(1,length(H)) R <- hsi2rgb(H, S, I)[1,] G <- hsi2rgb(H, S ,I)[2,] B <- hsi2rgb(H, S, I)[3,] col_hsi <- rgb(R, G, B, maxColorValue = 255) gr1 <- (0.34*R + 0.5*G + 0.16*B)/255 grey_hsi <- grey(gr1) col_hsv <- hsv(H/360, S, I) hsv_rgb <- col2rgb(col_hsv) gr2 <- (0.34 * hsv_rgb[1,] + 0.5 * hsv_rgb[2,] + 0.16 * hsv_rgb[3,]) / 255 grey_hsv <- grey(gr2) par(mfrow=c(2,1), mar = rep(2,4)) barplot(rep(1,length(H)), col = col_hsi, border = NA, beside = FALSE, space = c(0,0), axes = FALSE, main="HSI color mapping", cex.main = 0.9) barplot(rep(1,length(H)), col = grey_hsi, border = NA, beside = FALSE, space = c(0,0), axes = FALSE) barplot(rep(1,length(H)), col = col_hsv, border = NA, beside = FALSE, space = c(0,0), axes = FALSE, main="HSV color mapping", cex.main = 0.9) barplot(rep(1,length(H)), col = grey_hsv, border = NA, beside = FALSE, space = c(0,0), axes = FALSE)
Below is an illustration for standard normal data.
par(mar = rep(1.5,4)) set.seed(100) cols <- data2col(rnorm(30)) barplot(rep(1,length(cols)), col = cols, border = NA, beside = FALSE, space = c(0,0), axes = FALSE, main="Standard normal data", cex.main = 0.8)
Color layout function
Next, we will consider displaying the colors in a specific order in a 2-D plane. "Hilbert curve", "Morton curve" and one method suggested by "rectangle" are provided corresponding to the three functions HilbertGlyph, MortonGlyph, and recGlyph. [@keim1996pixel] Each function can give a png format matrix or a class of pixmap which can be considered as a glyph. The glyph can also be treated as a basic element to plot.
Hilbert <- function(x = 0,y= 0,level, drawFn, col,Repeat = FALSE, plot = TRUE, ...){ if (plot) { plot(0,type='n', xlim=c(0, x+2^level), ylim=c(0,y+2^level),axes = FALSE,xlab = "", ylab = "", ...) } maxLength <- 2^(2*level) y <- 2^level if(missing(col)) col <- rainbow(maxLength) if (Repeat){ if(length(col) != maxLength) { col <- rep_len(col, length.out = maxLength) } } if(missing(drawFn)) { drawFn <- function(x,y, num, col) { rect(x,y-1,x+1,y,col = col) points(x+1/2, y-1/2, pch=paste(num%%10), cex = 0.8) } } locNum <- 1 SetLocImage <- function(x,y,col){ drawFn(x,y, locNum, col = col[locNum]) locNum <<- locNum + 1 } move <- function(d){ switch(d, down = {y <<- y-1 x <<- x}, up = {y <<- y+1 x <<- x}, right = {x <<- x+1 y <<- y}, left = {x <<- x-1 y <<- y} ) } if (level %% 2 == 1){ HilbertStep <- function(R,D,L,U,level, col){ if (level > 0){ HilbertStep(D,R,U,L,level-1, col) SetLocImage(x,y,col) move(R) HilbertStep(R,D,L,U,level-1, col) SetLocImage(x,y,col) move(D) HilbertStep(R,D,L,U,level-1, col) SetLocImage(x,y,col) move(L) HilbertStep(U,L,D,R,level-1, col) } } HilbertStep("right","down","left","up",level, col) SetLocImage(x,y,col) } else { HilbertStep <- function(D,R,U,L,level, col){ if (level > 0){ HilbertStep(R,D,L,U,level-1, col) SetLocImage(x,y,col) move(R) HilbertStep(D,R,U,L,level-1, col) SetLocImage(x,y,col) move(D) HilbertStep(D,R,U,L,level-1, col) SetLocImage(x,y,col) move(L) HilbertStep(L,U,R,D,level-1, col) } } HilbertStep("right","down","left","up",level, col) SetLocImage(x,y,col) } } par(mfrow = c(2,3), mar = rep(1, 4)) Hilbert(level=1, main = "Hilbert curve(level=1)", cex.main = 0.8) Hilbert(level=2, main = "Hilbert curve(level=2)", cex.main = 0.8) Hilbert(level=3, main = "Hilbert curve(level=3)", cex.main = 0.8) plot_matrix <- matrix(nrow = 2^(2*1), ncol = 2) Hilbert(level=1, drawFn = function(x,y,locNum,col) {plot_matrix[locNum,] <<- c(x+0.5, y-0.5)}, plot = FALSE) plot(data.frame(plot_matrix), type = "l", axes = FALSE, xlab = "", ylab = "") plot_matrix <- matrix(nrow = 2^(2*2), ncol = 2) Hilbert(level=2, drawFn = function(x,y,locNum,col) {plot_matrix[locNum,] <<- c(x+0.5, y-0.5)}, plot = FALSE) plot(data.frame(plot_matrix), type = "l", axes = FALSE, xlab = "", ylab = "") plot_matrix <- matrix(nrow = 2^(2*3), ncol = 2) Hilbert(level=3, drawFn = function(x,y,locNum,col) {plot_matrix[locNum,] <<- c(x+0.5, y-0.5)}, plot = FALSE) plot(data.frame(plot_matrix), type = "l", axes = FALSE, xlab = "", ylab = "") Morton <- function(x=0,y=0,level,drawFn,col,Repeat = FALSE, plot = TRUE, ...){ if (plot) { plot(0,type='n', xlim=c(0, x+2^level), ylim=c(0,y+2^level),axes = FALSE,xlab = "", ylab = "", ...) } maxLength <- 2^(2*level) y <- 2^level if(missing(col)) col <- rainbow(maxLength) if (Repeat){ if(length(col) != maxLength) { col <- rep_len(col, length.out = maxLength) } } if(missing(drawFn)) { drawFn <- function(x,y, num, col) { rect(x,y-1,x+1,y,col = col) points(x+1/2, y-1/2, pch=paste(num%%10), cex = 0.8) } } locNum <- 1 SetLocImage <- function(x,y,col){ drawFn(x,y, locNum, col = col[locNum]) locNum <<- locNum + 1 } MortonStep <- function(x,y,level,col){ if (level>1){ MortonStep(x,y,level-1,col) MortonStep(x+2^(level-1),y,level-1,col) MortonStep(x,y-2^(level-1),level-1,col) MortonStep(x+2^(level-1),y-2^(level-1),level-1,col) } else{ SetLocImage(x,y,col) SetLocImage(x <- x+1,y, col) SetLocImage(x <- x-1,y <- y-1,col) SetLocImage(x <- x+1, y,col) } } MortonStep(x,y,level,col) } Morton(level = 1, main = "Morton Curve(level=1)", cex.main = 0.8) Morton(level = 2, main = "Morton Curve(level=2)", cex.main = 0.8) Morton(level = 3, main = "Morton Curve(level=3", cex.main = 0.8) plot_matrix <- matrix(nrow = 2^(2*1), ncol = 2) Morton(level=1, drawFn = function(x,y,locNum,col) {plot_matrix[locNum,] <<- c(x+0.5, y-0.5)}, plot = FALSE) plot(data.frame(plot_matrix), type = "l", axes = FALSE, xlab = "", ylab = "") plot_matrix <- matrix(nrow = 2^(2*2), ncol = 2) Morton(level=2, drawFn = function(x,y,locNum,col) {plot_matrix[locNum,] <<- c(x+0.5, y-0.5)}, plot = FALSE) plot(data.frame(plot_matrix), type = "l", axes = FALSE, xlab = "", ylab = "") plot_matrix <- matrix(nrow = 2^(2*3), ncol = 2) Morton(level=3, drawFn = function(x,y,locNum,col) {plot_matrix[locNum,] <<- c(x+0.5, y-0.5)}, plot = FALSE) plot(data.frame(plot_matrix), type = "l", axes = FALSE, xlab = "", ylab = "") RecP <- function(x=0,y=0,drawFn,width,height,col,Repeat = FALSE, plot = TRUE, ...){ if(missing(width)) width <- c(7,1,12) if(missing(height)) height <- c(1,4,1) if (plot) { plot(c(0,prod(width)),c(0,prod(height)), type = "n", axes = FALSE, xlab = "", ylab = "", ...) } maxLength <- prod(width)*prod(height) y <- prod(height) if(missing(col)) col <- rainbow(maxLength) if (Repeat){ if(length(col) != maxLength) { col <- rep_len(col, length.out = maxLength) } } if(missing(drawFn)) { drawFn <- function(x,y, num, col) { rect(x,y-1,x+1,y,col = col) points(x+1/2, y-1/2, pch=paste(num%%10), cex = 0.8) } } locNum <- 1 SetLocImage <- function(x,y,col){ drawFn(x,y, locNum, col = col[locNum]) locNum <<- locNum + 1 } level <- length(height) next_x <- numeric(level+1) next_y <- numeric(level+1) next_x[1] <- 1 next_y[1] <- 1 for(i in 2: (level+1)){ next_x[i] <- prod(width[1:(i-1)]) next_y[i] <- prod(height[1:(i-1)]) } RecPStep <- function(x,y,level,col){ if (level == 0){ SetLocImage(x,y,col) } else { if (level == 1){ for(h in 1:height[level]){ if (h%%2 == 1){ for(w in 1:width[level]){ RecPStep(x,y,level-1,col) x <- x + next_x[level] } } else { for(w in 1:width[level]){ x <- x - next_x[level] RecPStep(x,y,level-1,col) } } y <- y - next_y[level] } } else { for(h in 1:height[level]){ for(w in 1:width[level]){ RecPStep(x,y,level-1,col) x <- x + next_x[level] } x <- x - next_x[level+1] y <- y - next_y[level] } } } } RecPStep(x,y,level,col) } # example RecP(width=3,height=3,Repeat = TRUE, main = "Keim's rectangle plot with width(3) and height(3)", cex.main = 0.8) RecP(width=c(3,2),height=c(3,2),Repeat = TRUE, main = "Keim's rectangle plot with width(3,2) and height(3,2)", cex.main = 0.8) RecP(width=c(3,2,2),height=c(3,2,2),Repeat = TRUE, main = "Keim's rectangle plot with width(3,2,2) and height(3,2,2)", cex.main = 0.8) plot_matrix <- matrix(nrow = 3*3, ncol = 2) RecP(width=3,height=3, drawFn = function(x,y,locNum,col) {plot_matrix[locNum,] <<- c(x+0.5, y-0.5)}, plot = FALSE) plot(data.frame(plot_matrix), type = "l", axes = FALSE, xlab = "", ylab = "") plot_matrix <- matrix(nrow = (3*2)*(3*2), ncol = 2) RecP(width=c(3,2),height=c(3,2), drawFn = function(x,y,locNum,col) {plot_matrix[locNum,] <<- c(x+0.5, y-0.5)}, plot = FALSE) plot(data.frame(plot_matrix), type = "l", axes = FALSE, xlab = "", ylab = "") plot_matrix <- matrix(nrow = (3*2*2)*(3*2*2), ncol = 2) RecP(width=c(3,2,2),height=c(3,2,2), drawFn = function(x,y,locNum,col) {plot_matrix[locNum,] <<- c(x+0.5, y-0.5)}, plot = FALSE) plot(data.frame(plot_matrix), type = "l", axes = FALSE, xlab = "", ylab = "")
One can see the order of each displaying method from the flow of the color, the number inside each square and the line graph shown in the right. Note that the plot starts from the top left corner and the sequence of numbers is module by 10.
For the Keim's rectangular method, the plot is drawn recursively and only the first level is in an "snake" order, and the rest start from the left end. This method can do better in the time series data, since the time order such as year, month and so on is in this recursive manner.
The illustration of some functions are shown below.
par(mar = rep(1.5,4)) cols <- rainbow(64) # get colors myPngmat <- HilbertGlyph(cols) # get a glyph of data matrix in png format plot(0,type='n', xlim=c(0,1), ylim=c(0,1), axes = FALSE, xlab = "", ylab = "", main = "HilbertGlyph draw", cex.main = 0.9) # background plot rasterImage(myPngmat,0,0,1,1) # plot the glyph myPngmat <- MortonGlyph(cols) plot(0,type='n', xlim=c(0,1), ylim=c(0,1), axes = FALSE, xlab = "", ylab = "", main = "MortonGlyph draw", cex.main = 0.9) rasterImage(myPngmat,0,0,1,1)
Make glyphs and plot them in a device
Then, for a multidimension data set, make_glyphs can get a list of glyphs from a list of data vectors. getGridXY provides x and y coordinates where we need to plot in a grid. Finally, plot_glyphs plots the glyphs in a specific device. Or one can use his own plot function to plot the glyphs generated by make_glyphs.
An illustration of student t distribution data plot is shown as follows. Also, we can choose the interested range that we want and lower value outside the range will be in blue while higher value will be in red.
par(mar = rep(1.5,4)) n <- 9 # data generated from student t distribution data <- list() for (i in 1:n){ data[[i]] <- rt(1000, df = 10) } glyphs <- make_glyphs(data,origin = "mean", type = "pixmap") # get glyphs in pixmap x <- getGridXY(n) # get the x and y coordinates to plot # plot glyphs plot_glyphs(x, glyphs = glyphs, glyphWidth = 0.8, glyphHeight = 0.8, type = "pixmap", axes = FALSE, xlab = "", ylab = "", main = "A list of 9 student t data sets with df=10", cex.main = 0.8) glyphs_outlier <- make_glyphs(data, type = "pixmap", xLow = -3, origin = 0, xHigh = 3) plot_glyphs(x, glyphs = glyphs_outlier, glyphWidth = 0.8, glyphHeight = 0.8, type = "pixmap", axes = FALSE, xlab = "", ylab = "", main = "A list of 9 student t data sets with df=10\n with range (-3,3)", cex.main = 0.8)
Finally, make_glyphs_draw is also a useful function which is more general. Given a list of data vectors, and any draw_fun, make_glyphs_draw can get a list of corresponding glyphs in almost all picture types. It can also be a tool to transform a list of glyphs between different picture forms.
Below shows an example of draw_fun=hist which is a built-in function in r.
par(mar = rep(1,4)) glyphs_hist <- make_glyphs_draw(data, draw_fun = function(data_i){hist(data_i, main = "", axes = FALSE, col = "steelblue")}, type = "png", mar = rep(1, 4), width = 100, height = 100) x <- getGridXY(n) plot_glyphs(x, glyphs = glyphs_hist, glyphWidth = 0.8, glyphHeight = 0.8, axes = FALSE, xlab = "", ylab = "")
Then an example of transforming glyphs from "pixmap" to "jpeg"
par(mar = rep(1.5,4)) plot_glyphs(x, glyphs = glyphs, glyphWidth = 0.8, glyphHeight = 0.8, type = "pixmap", axes = FALSE, xlab = "", ylab = "", main = "A list of 9 student t data sets with df=10\n (pixmap)", cex.main = 0.7) glyphs_jpeg <- make_glyphs_draw(data = glyphs, draw_fun = function(data_i){ plot_glyphs(getGridXY(1),glyphs = list(data_i), type = "pixmap", axes = FALSE, xlab = "", ylab = "") }, type = "jpeg", mar = rep(0, 4), width = 100, height = 100) plot_glyphs(x, glyphs = glyphs_jpeg, glyphWidth = 0.8, glyphHeight = 0.8, axes = FALSE, xlab = "", ylab = "", main = "A list of 9 student t data sets with df=10 \n (jpeg)", cex.main = 0.7)
Reference
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.