300 lines
9.6 KiB
R
Raw Normal View History

# Created By Miha 23.4.2021
#------------ DESC ------------#
# Podatki bodo pridobljeni v
# dveh stolpcih in brez
# naslovov. Gre za plain tekst
# oz labele in števila
# ki ji preberemo in prikažemo
# na radar grafu
# Prvi stolpec so labele in
# drugi stolpec vrednosti
#---------- //DESC// ----------#
#----------------- ENCODING 1KA STREŽNNIK ----------------#
# Nastavimo encoding za potrebe strežnika
# Pogosto se na 1KA strežniku pokvarijo šumniki
# zato šumniki (v PDF poročilu) lokalno delajo
# na strežniku pa ne
Sys.setlocale(category = "LC_ALL", locale = "slovenian")
#--------------- //ENCODING 1KA STREŽNNIK// --------------#
##############################
# RADAR CHART FOR NIJZ
##############################
#------------------ LIBRARIES -------------------#
# required libraries (radar chart)
library(fmsb)
# required libraries export image
library(Cairo)
#---------------- //LIBRARIES// -----------------#
#-------------------- MODOFY RADARSHART FUNCTION ------------------------#
# In order to rotate labels the original function must be modyfied
radarchart2 <-
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, vlcex = NULL, caxislabels = NULL, calcex = NULL,
paxislabels = NULL, palcex = NULL, ...)
{
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)
}
plot(c(-1.2, 1.2), c(-1.2, 1.2), type = "n", frame.plot = FALSE,
axes = FALSE, xlab = "", ylab = "", main = title,
asp = 1, ...)
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, srt=20)
else text(xx * 1.2, yy * 1.2, VLABELS, cex = vlcex, srt=20)
series <- length(df[[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)
}
}
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])
}
}
}
#------------------ //MODIFY RADARSHART FUNCTION// ----------------------#
# Dobimo id respondenta, ker je ta stevilka v imenu csv datoteke in tudi v imenu grafa, ki se potem zgenerira
params <- commandArgs(trailingOnly=TRUE)
respondent_id <- params[1]
#------------------------------ READ DATA ----------------------------#
# Import data
data <- read.csv2(
2021-04-26 12:26:32 +02:00
paste0("../../admin/survey/modules/mod_NIJZ/temp/nijz_", respondent_id, ".csv"),
sep = ";",
header = FALSE,
stringsAsFactors = FALSE,
encoding = 'UTF-8'
)
# Remove missing values
data <-
subset(data,
!is.na(data$V2) | data$V2 < 0)
# Because we will reverse the order
# client wopudl liek to have
# Label 1 at 12.00 in plot
data <- rbind( data[-1, ], data[1, ])
#--------------------------- // READ DATA // ------------------------#
#-------------------------- RADAR CHART -----------------------------#
CairoPNG(paste0('../../admin/survey/modules/mod_NIJZ/results/radar_', respondent_id, '.png'), width = 900, height = 700) # Export chart to png
# Create rang which will be labeld in grapf (10 likert scale)
2021-04-28 07:40:36 +02:00
myrange <- c(0, 7)
# create a data frame with the max and min as the first two rows
mydf <-
as.data.frame(rbind(max = myrange[2], min = myrange[1], data$V2),
stringsAsFactors = FALSE)
# Add names which will be displayed as labels in
# chart and also their means in parentheses
# Deljenje besed zaradi preglednosti
labels <- gsub('(.{1,18})(\\s|$)', '\\1\n', data$V1)
colnames(mydf) <- labels
# Nastavitve fonta na željo naročnika
par(col="#004078", font = 2, cex = 0.8, xpd = TRUE)
# Plot a radar chart
radarchart2(
rev(mydf),
pcol = "#D0D0D0",
pfcol = scales::alpha("#D0D0D0", 0.5),
# Customize the grid
cglcol = scales::alpha("grey", 0.6),
cglty = 1,
cglwd = 1,
# Customize the axis
axislabcol = "black",
na.itp = FALSE,
plwd = 3,
plty = 1,
2021-04-28 07:40:36 +02:00
seg = 7,
axistype = 1,
2021-04-28 07:40:36 +02:00
caxislabels = 0:7,
centerzero = TRUE
)
#------------------------ //RADAR CHART//----------------------------#
dev.off()