Skip to content
Snippets Groups Projects
Commit 2069ccfa authored by Eva Budinská's avatar Eva Budinská
Browse files

Upload New File

parent 77b62fb8
No related branches found
No related tags found
No related merge requests found
Hide whitespace changes
Inline Side-by-side
Showing
with 257 additions and 0 deletions
radchar3-EB.R 0 → 100644
+ 257
− 0
View file @ 2069ccfa
#creating example dataset
maxmin <- data.frame(
total=c(5, 1),
phys=c(15, 3),
psycho=c(3, 0),
social=c(5, 1),
env=c(5, 1))
set.seed(123)
dat <- data.frame(
total=runif(3, 1, 5),
phys=rnorm(3, 10, 2),
psycho=c(0.5, NA, 3),
social=runif(3, 1, 5),
env=c(5, 2.5, 4))
#setting parameters
axistype = 0
seg = 4
pty = 16
pcol = 1:8
plty = 1:6
plwd = 1
pdensity = NULL
pangle = 45
pfcol = NA
cglty = 3
cglwd = 1
cglcol = "navy"
axislabcol = "blue"
title = ""
maxmin = TRUE
na.itp = TRUE
centerzero = FALSE
vlabels = NULL
vnums = NULL
vlcex = NULL
caxislabels = NULL
calcex = NULL
paxislabels = NULL
palcex = NULL
cex.main = 1
vlcol = "black"
radarchart(dat, axistype=1, seg=5, plty=1, vlabels=c("Total\nQOL", "Physical\naspects", "Phychological\naspects", "Social\naspects", "Environmental\naspects"),
title="(axis=1, 5 segments, with specified vlabels)", vlcex=0.5)
radchar <- function (df, axistype = 0, seg = 4, pty = 16, pcol = 1:8, plty = 1:6,
plwd = 1, pdensity = NULL, pangle = 45, pfcol = NA, cglty = 3,
cglwd = 1, cglcol = "navy", axislabcol = "blue", title = "",
maxmin = TRUE, na.itp = TRUE, centerzero = FALSE, vlabels = NULL, vnums = NULL,
vlcex = NULL, caxislabels = NULL, calcex = NULL, paxislabels = NULL,
palcex = NULL, cex.main = 1, vlcol = "black", vzn = vzn)
# vnums - table with medians of abundance in groups
# vzn - table of names of objects to plot & colors of significance
{
if (!is.data.frame(df)) {
cat("The data must be given as dataframe.\n")
return()
}
if ((n <- length(df)) < 3) {
cat("The number of variables must be 3 or more.\n")
return()
}
if (maxmin == FALSE) {
dfmax <- apply(df, 2, max)
dfmin <- apply(df, 2, min)
df <- rbind(dfmax, dfmin, df)
}
par(mar = c(5.1, 4.1, 4.1, 2.1))
plot(c(-1.2, 1.2), c(-1.2, 1.2), type = "n", frame.plot = FALSE,
axes = FALSE, xlab = "", ylab = "", main = title, asp = 1, cex.main = cex.main
)
theta <- seq(90, 450, length = n + 1) * pi/180
theta <- theta[1:n]
xx <- cos(theta)
yy <- sin(theta)
CGap <- ifelse(centerzero, 0, 1)
for (i in 0:seg) {
polygon(xx * (i + CGap)/(seg + CGap), yy * (i + CGap)/(seg +
CGap), lty = cglty, lwd = cglwd, border = cglcol)
if (axistype == 1 | axistype == 3)
CAXISLABELS <- paste(i/seg * 100, "(%)")
if (axistype == 4 | axistype == 5)
CAXISLABELS <- sprintf("%3.2f", i/seg)
if (!is.null(caxislabels) & (i < length(caxislabels)))
CAXISLABELS <- caxislabels[i + 1]
if (axistype == 1 | axistype == 3 | axistype == 4 | axistype ==
5) {
if (is.null(calcex))
text(-0.05, (i + CGap)/(seg + CGap), CAXISLABELS,
col = axislabcol)
else text(-0.05, (i + CGap)/(seg + CGap), CAXISLABELS,
col = axislabcol, cex = calcex)
}
}
if (centerzero) {
arrows(0, 0, xx * 1, yy * 1, lwd = cglwd, lty = cglty,
length = 0, col = cglcol)
}
else {
arrows(xx/(seg + CGap), yy/(seg + CGap), xx * 1, yy *
1, lwd = cglwd, lty = cglty, length = 0, col = cglcol)
}
PAXISLABELS <- df[1, 1:n]
if (!is.null(paxislabels))
PAXISLABELS <- paxislabels
if (axistype == 2 | axistype == 3 | axistype == 5) {
if (is.null(palcex))
text(xx[1:n], yy[1:n], PAXISLABELS, col = axislabcol)
else text(xx[1:n], yy[1:n], PAXISLABELS, col = axislabcol,
cex = palcex)
}
VLABELS <- colnames(df)
if (!is.null(vlabels))
VLABELS <- vlabels
if (is.null(vlcex)) {text(xx * 1.2, yy * 1.2, VLABELS, col = vlcol)} else {text((xx * 1.2)+0.02, (yy * 1.2)+0.02, VLABELS, cex = vlcex, col = vlcol)}
#text((xx * 1.2), (yy * 1.2), VLABELS, cex = vlcex, col = vlcol)
series <- length(df[[1]])
VNUMS <- vnums
# significance
rect((xx * 1.2)+0.065, (yy * 1.2)+0.075, (xx * 1.2)+0.035, (yy * 1.2)+0.045, lwd = 0.1, col = as.character(vzn[, 4]))
rect((xx * 1.2)+0.035, (yy * 1.2)+0.075, (xx * 1.2)+0.005, (yy * 1.2)+0.045, lwd = 0.1, col = as.character(vzn[, 3]))
rect((xx * 1.2)-0.025, (yy * 1.2)+0.075, (xx * 1.2)+0.005, (yy * 1.2)+0.045, lwd = 0.1, col = as.character(vzn[, 2]))
rect((xx * 1.2)-0.025, (yy * 1.2)+0.075, (xx * 1.2)+0.005, (yy * 1.2)+0.045, lwd = 0.1, col = as.character(vzn[, 1]))
SX <- series - 2
if (length(pty) < SX) {
ptys <- rep(pty, SX)
} else {
ptys <- pty
}
if (length(pcol) < SX) {
pcols <- rep(pcol, SX)
} else {
pcols <- pcol
}
if (length(plty) < SX) {
pltys <- rep(plty, SX)
} else {
pltys <- plty
}
if (length(plwd) < SX) {
plwds <- rep(plwd, SX)
} else {
plwds <- plwd
}
if (length(pdensity) < SX) {
pdensities <- rep(pdensity, SX)
} else {
pdensities <- pdensity
}
if (length(pangle) < SX) {
pangles <- rep(pangle, SX)
} else {
pangles <- pangle
}
if (length(pfcol) < SX) {
pfcols <- rep(pfcol, SX)
} else {
pfcols <- pfcol
}
for (i in 3:series) {
xxs <- xx
yys <- yy
scale <- CGap/(seg + CGap) + (df[i, ] - df[2, ])/(df[1,
] - df[2, ]) * seg/(seg + CGap)
if (sum(!is.na(df[i, ])) < 3) {
cat(sprintf("[DATA NOT ENOUGH] at %d\n%g\n", i, df[i,
]))
} else {
for (j in 1:n) {
if (is.na(df[i, j])) {
if (na.itp) {
left <- ifelse(j > 1, j - 1, n)
while (is.na(df[i, left])) {
left <- ifelse(left > 1, left - 1, n)
}
right <- ifelse(j < n, j + 1, 1)
while (is.na(df[i, right])) {
right <- ifelse(right < n, right + 1, 1)
}
xxleft <- xx[left] * CGap/(seg + CGap) +
xx[left] * (df[i, left] - df[2, left])/(df[1,
left] - df[2, left]) * seg/(seg + CGap)
yyleft <- yy[left] * CGap/(seg + CGap) +
yy[left] * (df[i, left] - df[2, left])/(df[1,
left] - df[2, left]) * seg/(seg + CGap)
xxright <- xx[right] * CGap/(seg + CGap) +
xx[right] * (df[i, right] - df[2, right])/(df[1,
right] - df[2, right]) * seg/(seg + CGap)
yyright <- yy[right] * CGap/(seg + CGap) +
yy[right] * (df[i, right] - df[2, right])/(df[1,
right] - df[2, right]) * seg/(seg + CGap)
if (xxleft > xxright) {
xxtmp <- xxleft
yytmp <- yyleft
xxleft <- xxright
yyleft <- yyright
xxright <- xxtmp
yyright <- yytmp
}
xxs[j] <- xx[j] * (yyleft * xxright - yyright *
xxleft)/(yy[j] * (xxright - xxleft) - xx[j] *
(yyright - yyleft))
yys[j] <- (yy[j]/xx[j]) * xxs[j]
} else {
xxs[j] <- 0
yys[j] <- 0
}
} else {
xxs[j] <- xx[j] * CGap/(seg + CGap) + xx[j] *
(df[i, j] - df[2, j])/(df[1, j] - df[2, j]) *
seg/(seg + CGap)
yys[j] <- yy[j] * CGap/(seg + CGap) + yy[j] *
(df[i, j] - df[2, j])/(df[1, j] - df[2, j]) *
seg/(seg + CGap)
}
text((xx[j] * 1.2)+0.11, (yy[j] * 1.2)-0.03*(i-2)+0.07, VNUMS[i-2,j], cex = vlcex)
}
if (is.null(pdensities)) {
polygon(xxs, yys, lty = pltys[i - 2], lwd = plwds[i -
2], border = pcols[i - 2], col = pfcols[i -
2])
} else {
polygon(xxs, yys, lty = pltys[i - 2], lwd = plwds[i -
2], border = pcols[i - 2], density = pdensities[i -
2], angle = pangles[i - 2], col = pfcols[i -
2])
}
points(xx * scale, yy * scale, pch = ptys[i - 2],
col = pcols[i - 2])
}
}
legend("topright",legend=c("K", "I","B"),fill=groupcols,border = c(groupcols), bty = "n", cex = .6, title = "Group (%):")
legend("topleft",legend=c('I to K', 'B to K', 'I to B'), fill = c('darkorchid4', 'cornflowerblue', 'deeppink3'), border = c('darkorchid4', 'cornflowerblue', 'deeppink3'), bty = "n", cex = .6, title = "Significance:")
for (k in 1:dim(df)[2]) {
# for (r in 3:series) {
#par(new=T, mar = c(12.6+5.1, 13+4.1, 12.6+4.1, 13+2.1))
par(new = T, mar = c(12.45+5.1+((yy[k] * 1.2)*9.96)-0.5,13.7+4.1+((xx[k] * 1.2)*10)-0.2,12.45+4.1-((yy[k] * 1.2)*9.96)+0.5,13.7+2.1-((xx[k] * 1.2)*10)+0.2))
#text((xx * scale)-0.04, (yy * scale) - 0.05, VNUMS[r-2,], cex = vlcex, col = pcols[r-2])
barplot(as.numeric(vnums[5:3, k]), horiz = T, col = groupcols[3:1], axes = F, border = NA)
# }
}
}
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Please register or to comment