May 4, 2022
> 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
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)
> 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"
>
> 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)
> 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)
> 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")
> 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 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