====== Multivariate visualization ======
May 4, 2022
===== Example dataset =====
> wdir <- "C:/Users/vlado/work2/nusa"
> setwd(wdir)
> S <- read.csv("SiN.csv",sep="",row.names=1)
> dim(S)
> colnames(S) <- c("GDPpc","LifeExp","InfMort","PhysM","Natality","Mortality")
> S
GDPpc LifeExp InfMort PhysM Natality Mortality
Austria 128 82 3.24 5.17 9.45 9.85
Croatia 65 77 8.74 3.00 8.65 12.88
Italy 97 83 3.16 3.98 6.95 11.31
Hungary 71 77 4.62 3.41 8.65 12.88
Slovenia 87 82 1.52 3.09 8.30 10.40
===== Andrews' curves =====
* https://rdrr.io/cran/andrews/man/andrews.html
* https://en.wikipedia.org/wiki/Andrews_plot
* https://stackoverflow.com/questions/70862871/ggplot2-plotting-andrews-curves !!!
* https://gist.github.com/yannabraham/5b71b9599b460968f72e9b7ae63868e7
* https://stat.ethz.ch/pipermail/r-help/2009-September/403701.html
* https://stackoverflow.com/questions/19891728/plotting-andrews-curves-of-subsets-of-a-data-frame-on-the-same-plot
Interesting
#' Compute Andrews' curves
#'
#' This function takes a numeric vector of input, and returns a function which
#' allows you to compute the value of the Andrew's curve at every point along
#' its path from -pi to pi.
#'
#' @param x input a new parameter
#' @return a function with single argument, theta
#'
#' @examples
#' a <- andrews(1:2)
#' a(0)
#' a(-pi)
#' grid <- seq(-pi, pi, length = 50)
#' a(grid)
#'
#' plot(grid, andrews(1:2)(grid), type = "l")
#' plot(grid, andrews(runif(5))(grid), type = "l")
andrews <- function(x) {
n <- length(x)
y <- rep(x[1] / sqrt(2), length(t))
function(t) {
for(i in seq(2, n, by = 1)) {
val <- i %/% 2 * t
y <- y + x[i] * (if(i %% 2 == 0) sin(val) else cos(val))
}
y / n
}
}
The standard procedure on CRAN has limited options. I added the parameter clx and the ... parameter for controling some graphical parameters. To be improved.
andrews <- function (df, type = 1, clr = NULL, clx = NULL, step = 100,
ymax = 10, main = NULL, sub = NULL,...)
{
if (step < 1)
step <- 100
n <- dim(df)[1]
m <- dim(df)[2]
plot.new()
if ((type == 1) | (type == 2) | (type == 4)) {
xmin <- (-pi)
xmax <- pi
}
else if (type == 3) {
xmin <- 0
xmax <- 4 * pi
}
plot.window(c(xmin, xmax), c(-ymax, ymax), ...)
title(main = main, sub = sub)
axis(1)
axis(2)
box()
lines(c(xmin, xmax), c(0, 0))
for (i in 1:m) df[, i] <- normalize(df[, i])
if(is.null(clx)){
clx <- rep(1, n)
if (!is.null(clr)) {
if (!is.numeric(df[, clr])) {
for (i in 1:n) {
for (a in 1:nlevels(df[, clr]))
if (levels(df[,clr])[a] == df[i, clr])
clx[i] <- rainbow(nlevels(df[, clr]))[a]
}
}
else {
for (i in 1:n) clx[i] <- hsv(0, 1, df[i, clr])
}
}
}
dfm <- numarray(df)
m <- dim(dfm)[2]
coorx <- 0:step
for (p in 0:step) coorx[p + 1] <- (xmin + (xmax - xmin)/step * p)
coory <- 0:step
for (i in 1:n) {
for (p in 0:step) {
coory[p + 1] <- 0
tt <- (xmin + (xmax - xmin)/step * p)
for (a in 1:m) {
if (type == 1) {
if (a == 1) {
coory[p + 1] <- dfm[i, a]/(2^0.5)
}
else {
cnst <- (a - 2)%/%2 + 1
if ((a - 2)%%2 == 0)
coory[p + 1] <- coory[p + 1] + dfm[i, a] * sin(cnst * tt)
else
coory[p + 1] <- coory[p + 1] + dfm[i, a] * cos(cnst * tt)
}
}
else if (type == 2) {
cnst <- (a - 1)%/%2 + 1
if ((a - 1)%%2 == 0)
coory[p + 1] <- coory[p + 1] + dfm[i, a] *
sin(cnst * tt)
else coory[p + 1] <- coory[p + 1] + dfm[i,
a] * cos(cnst * tt)
}
else if (type == 3) {
coory[p + 1] <- coory[p + 1] + dfm[i, a] *
cos((a * tt)^0.5)
}
else if (type == 4) {
if (a == 1) {
coory[p + 1] <- dfm[i, a]
}
else {
cnst <- (a - 2)%/%2 + 1
if ((a - 2)%%2 == 0)
coory[p + 1] <- coory[p + 1] + dfm[i, a] *
(sin(cnst * tt) + cos(cnst * tt))
else coory[p + 1] <- coory[p + 1] + dfm[i,
a] * (sin(cnst * tt) - cos(cnst * tt))
}
coory[p + 1] <- coory[p + 1]/(2^0.5)
}
}
}
lines(coorx, coory, col = clx[i], ...)
}
}
Make a picture
> S[,"clr"] <- 1:5
> andrews(df = S,clr=7,clx=rainbow(5),ymax=3,lwd=2)
> legend("topleft", # Add legend to plot
+ legend = row.names(S),
+ col = rainbow(5),
+ pch = 16)
===== Faces =====
* https://cran.r-project.org/web/packages/aplpack/
* https://cran.r-project.org/web/packages/aplpack/aplpack.pdf
* https://cran.r-project.org/web/packages/aplpack/vignettes/sliderfns.pdf
* https://search.r-project.org/CRAN/refmans/aplpack/html/faces.html
* https://rdrr.io/cran/DescTools/man/PlotFaces.html
* https://flowingdata.com/2010/08/31/how-to-visualize-data-with-cartoonish-faces/
* https://github.com/Selbosh/ggChernoff
* https://selbydavid.com/2017/06/25/ggchernoff/
* http://phoenix.wiwi.uni-bielefeld.de/lehrbereiche/statoekoinf/comet/wolf/wolf_aplpack
* https://stackoverflow.com/questions/13065609/chernoff-faces-extended-in-r
> install.packages("aplpack")
> library(aplpack)
> faces(S[,1:6])
effect of variables:
modified item Var
"height of face " "GDPpc"
"width of face " "LifeExp"
"structure of face" "InfMort"
"height of mouth " "PhysM"
"width of mouth " "Natality"
"smiling " "Mortality"
"height of eyes " "GDPpc"
"width of eyes " "LifeExp"
"height of hair " "InfMort"
"width of hair " "PhysM"
"style of hair " "Natality"
"height of nose " "Mortality"
"width of nose " "GDPpc"
"width of ear " "LifeExp"
"height of ear " "InfMort"
>
===== Stars and segments =====
* https://rdrr.io/cran/tourr/man/display_stars.html
* https://www.rdocumentation.org/packages/graphics/versions/3.6.2/topics/stars
* https://stat.ethz.ch/R-manual/R-devel/library/graphics/html/stars.html
> require(grDevices)
> stars(S[, 1:6], key.loc = c(14, 1.5),
+ main = "Neighbors : full stars()", flip.labels = FALSE)
> palette(rainbow(12, s = 0.6, v = 0.75))
> stars(S[, 1:6], len = 0.6, key.loc = c(1.5, 0),
+ main = "Neighbors", draw.segments = TRUE,
+ frame.plot = TRUE, nrow = 4, cex = .7)
> stars(S[, 1:6], locations = NULL, radius = TRUE,
+ key.loc = c(5, 2), main = "Neighbors", lty = 1)
> palette(rainbow(6))
> stars(S[, 1:6], len = 0.8, key.loc = c(6.7, 1.8),
+ main = "Neighbors", draw.segments = TRUE,
+ frame.plot = FALSE, nrow = 2, ncol=3, cex = 0.8)
===== Radar chart =====
* https://www.datanovia.com/en/blog/beautiful-radar-chart-in-r-using-fmsb-and-ggplot-packages/
* https://r-graph-gallery.com/142-basic-radar-chart.html
* https://r-graph-gallery.com/143-spider-chart-with-saveral-individuals.html
* https://r-graph-gallery.com/circular-barplot.html
> install.packages("fmsb")
> library(fmsb)
> colBorder=c( rgb(0.2,0.5,0.5,0.9), rgb(0.8,0.2,0.5,0.9) , rgb(0.7,0.5,0.1,0.9),
+ rgb(0.9,0.1,0.1,0.9) , rgb(0.1,0.1,0.9,0.9) )
> colIn=c( rgb(0.2,0.5,0.5,0.4), rgb(0.8,0.2,0.5,0.4) , rgb(0.7,0.5,0.1,0.4),
+ rgb(0.9,0.1,0.1,0.4) , rgb(0.1,0.1,0.9,0.4) )
> data <- S[,1:6]
> i <- 5
> item <- rbind(apply(data, 2, max),apply(data, 2, min),data[i,])
> radarchart(item,pcol=colBorder[i], pfcol=colIn[i],plwd=4,plty=1,
+ cglcol="grey",cglty=1,axislabcol="grey",caxislabels=seq(0,20,5),cglwd=0.8)
===== Example 2 =====
> x <- c(1,2,3,1.5,2.5,7,7.5,8)
> y <- c(2,1.5,1,5,5.5,6,6.5,7)
> x1 <- c(0,x,8.5)
> x2 <- c(0,y,7.8)
> plot(x1,x2,pch=16,cex=2,type="n")
> points(x,rep(-0.28,8),pch=16,cex=2,col="red")
> points(rep(-0.28,8),y,pch=16,cex=2,col="blue")
> points(x,y,pch=16,cex=2)
> XY <- data.frame(x,y,row.names=paste("U",1:8,sep=""))
> text(x+0.3,y,row.names(XY))
> D <- dist(XY)
> t <-hclust(D,method="complete")
> plot(t,hang=-1,cex=1,main="Clustering / Complete")
===== Euclidean / picture =====
> a <- c(30,50)
> s <- c(16,12)
> Age <- c(0,a,63)
> School <- c(0,s,19)
> plot(Age,School,type="n")
> lines(a,s,type="b",pch=16,cex=2,lwd=2)
> text(25,17.5,"Janez",cex=1.5)
> text(54.5,11,"Peter",cex=1.5)
> x1 <- c(-3,30); y1 <- c(16,16); lines(x1,y1,col="Blue")
> x2 <- c(-3,50); y2 <- c(12,12); lines(x2,y2,col="Blue")
> x3 <- c(30,30); y3 <- c(-3,16); lines(x3,y3,col="Blue")
> x4 <- c(50,50); y4 <- c(-3,12); lines(x4,y4,col="Blue")
===== Model =====
Model picture description in Pajek
*Vertices 11
1 "NOT IN BACKGROUND" 0.0952 0.1667 0.5000 box x_fact 6
2 "SAY A LOT" 0.0952 0.3333 0.5000
3 "ATTENTION" 0.0952 0.5000 0.5000
4 "NOT QUIET" 0.0952 0.6667 0.5000
5 "LIFE OF A PARTY" 0.0952 0.8333 0.5000
6 "U1" 0.4762 0.3333 0.5000 ellipse
7 "U2" 0.4762 0.6667 0.5000
8 "V1" 0.6190 0.3333 0.5000
9 "V2" 0.6190 0.6667 0.5000
10 "EDU" 0.8571 0.1667 0.5000 box x_fact 2
11 "AGE" 0.8571 0.8333 0.5000
*Arcs
1 6 0.800000000
2 6 0.640000000
3 6 0.530000000
4 6 0.470000000
5 7 0.760000000
10 8 0.460000000
10 9 -0.890000000 p Solid
11 8 -0.850000000 p Solid
11 9 -0.520000000 p Solid
*Edges
6 8 0.430000000
7 9 0.210000000
===== URLs =====
* https://r-graph-gallery.com/heatmap
* https://r-graph-gallery.com/sankey-diagram.html
* https://r-graph-gallery.com/network.html
* https://r-graph-gallery.com/hierarchical-edge-bundling.html
* https://jtr13.github.io/cc19/radar-plots-to-show-multivariate-continuous-data.html
* https://statisticsglobe.com/segments-r-example/
* https://jokergoo.github.io/circlize_book/book/graphics.html