Popravek grafa, label in teksta za NIJZ
This commit is contained in:
Miha
parent
e5be19d9fe
commit
43f1a42648
@ -20,12 +20,13 @@ Sys.setlocale(category = "LC_ALL", locale = "slovenian")
|
||||
#------------- PASSING ARGUMENTS FROM CMD LINE ----------------#
|
||||
params <- commandArgs(trailingOnly=TRUE)
|
||||
ID <- params[1]
|
||||
#ID <- "26155472"
|
||||
#------------- PASSING ARGUMENTS FROM CMD LINE ----------------#
|
||||
|
||||
|
||||
#-------------------------- USER DEFINED FUNCTION ---------------------#
|
||||
# Za potrebe pravilnega prikaza teksta v posameznih poglavjih
|
||||
latexTranslate <- function(x, color = "NE") {
|
||||
lxTranslate <- function(x, color = "NE", pisava = TRUE) {
|
||||
x <- gsub("<strong>", "\\\\\\\\textbf{", x)
|
||||
x <- gsub("</strong>", "}", x)
|
||||
x <-
|
||||
@ -45,21 +46,24 @@ latexTranslate <- function(x, color = "NE") {
|
||||
# Update, Potem pa želi NIJZ, da se prvi odstavek
|
||||
# vedno obarva z "zeleno barvo, zaot moramo to
|
||||
# utrezno ločiti
|
||||
obarvajX <- stringr::str_extract(x, "[^}]+")
|
||||
obarvajX <- stringr::str_extract(x, "[^.|!]+")
|
||||
|
||||
# DOdamo barvanje
|
||||
obarvajX_1 <- paste0("{\\\\color{zelena}", obarvajX, "}")
|
||||
# Nadomestimo
|
||||
x <- gsub(obarvajX, obarvajX_1, x, fixed=TRUE)
|
||||
}
|
||||
# val <- strsplit(x, "\\\\newline ")[[1]]
|
||||
#
|
||||
# # Gledamo tretji
|
||||
# odst <- val[4:length(val)]
|
||||
|
||||
if (pisava == TRUE) {
|
||||
val <- strsplit(x, "\\\\newline ")[[1]]
|
||||
|
||||
# Gledamo tretji
|
||||
odst <- val[4:length(val)]
|
||||
|
||||
# Po drugem odstavku zmanjšamo pisavo na 9
|
||||
|
||||
|
||||
xsmall <- paste0("\\\\begin{footnotesize}", stringr::str_c(odst, collapse = "\\\\newline "), "\\\\end{footnotesize}")
|
||||
|
||||
x <- paste0(stringr::str_c(val[1:4], collapse = "\\\\newline "),xsmall)
|
||||
}
|
||||
return(x)
|
||||
}
|
||||
#------------------------ //USER DEFINED FUNCTION// -------------------#
|
||||
@ -114,6 +118,203 @@ colnames(data)[2] <- "V2"
|
||||
#--------------------------- // READ DATA // ------------------------#
|
||||
|
||||
|
||||
|
||||
#-------------------- 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// ----------------------#
|
||||
|
||||
|
||||
|
||||
#-------------------------- RADAR CHART -----------------------------#
|
||||
CairoPNG('modules/mod_NIJZ/results/img/radar.png', width = 900, height = 700) # Export chart to png
|
||||
|
||||
@ -141,9 +342,11 @@ colnames(mydf) <- labels
|
||||
# Deljenje besed zaradi preglednosti
|
||||
|
||||
|
||||
par(col="#004078", font = 2, cex = 1.4)
|
||||
#par(col="#004078", font = 2, cex = 1.4)
|
||||
|
||||
par(col="#004078", font = 2, cex = 0.8, xpd = TRUE)
|
||||
# Plot a radar chart
|
||||
radarchart(
|
||||
radarchart2(
|
||||
mydf,
|
||||
pcol = "#D0D0D0",
|
||||
pfcol = scales::alpha("#D0D0D0", 0.5),
|
||||
@ -168,7 +371,7 @@ dev.off()
|
||||
|
||||
#------------------------ 1. Moj FOTOTIP KOŽE: ------------------------#
|
||||
varianta <- data %>% filter(str_detect(V1, "VARIANTA")) %>% select(V2)
|
||||
varianta <- latexTranslate(varianta)
|
||||
varianta <- lxTranslate(varianta, pisava = FALSE)
|
||||
|
||||
|
||||
#----------------------- //1. Moj FOTOTIP KOŽE:// ----------------------#
|
||||
@ -177,7 +380,7 @@ varianta <- latexTranslate(varianta)
|
||||
#------------------------ Poletni urnik za izvajanje aktivnosti na prostem ------------------------#
|
||||
|
||||
sonce <- data %>% filter(str_detect(V1, "SONCE")) %>% select(V2)
|
||||
sonce <- latexTranslate(sonce, color = "DA")
|
||||
sonce <- lxTranslate(sonce, color = "DA")
|
||||
|
||||
#----------------------- Poletni urnik za izvajanje aktivnosti na prostem ----------------------#
|
||||
|
||||
@ -185,7 +388,7 @@ sonce <- latexTranslate(sonce, color = "DA")
|
||||
#------------------------ Poletni urnik za izvajanje aktivnosti na prostem ------------------------#
|
||||
|
||||
oblacila <- data %>% filter(str_detect(V1, "OBLACILA")) %>% select(V2)
|
||||
oblacila <- latexTranslate(oblacila, color = "DA")
|
||||
oblacila <- lxTranslate(oblacila, color = "DA")
|
||||
|
||||
#----------------------- Poletni urnik za izvajanje aktivnosti na prostem ----------------------#
|
||||
|
||||
@ -194,7 +397,7 @@ oblacila <- latexTranslate(oblacila, color = "DA")
|
||||
#------------------------ Poletni urnik za izvajanje aktivnosti na prostem ------------------------#
|
||||
|
||||
solarij <- data %>% filter(str_detect(V1, "SOLARIJ")) %>% select(V2)
|
||||
solarij <- latexTranslate(solarij, color = "DA")
|
||||
solarij <- lxTranslate(solarij, color = "DA")
|
||||
|
||||
#---
|
||||
|
||||
@ -202,7 +405,7 @@ solarij <- latexTranslate(solarij, color = "DA")
|
||||
#------------------------ Poletni urnik za izvajanje aktivnosti na prostem ------------------------#
|
||||
|
||||
kemija <- data %>% filter(str_detect(V1, "KEMIJA")) %>% select(V2)
|
||||
kemija <- latexTranslate(kemija, color = "DA")
|
||||
kemija <- lxTranslate(kemija, color = "DA")
|
||||
|
||||
#---
|
||||
|
||||
@ -253,7 +456,7 @@ tex.glava <-
|
||||
tex.glava <-
|
||||
gsub(
|
||||
pattern = '!solarij!',
|
||||
replacement = Hmisc::latexTranslate(solarij),
|
||||
replacement = solarij,
|
||||
x = tex.glava
|
||||
)
|
||||
|
||||
@ -261,7 +464,7 @@ tex.glava <-
|
||||
tex.glava <-
|
||||
gsub(
|
||||
pattern = '!kemija!',
|
||||
replacement = Hmisc::latexTranslate(kemija),
|
||||
replacement = kemija,
|
||||
x = tex.glava
|
||||
)
|
||||
#---------------------- //LATEX KOSI// --------------------#
|
||||
|
||||
@ -12,7 +12,7 @@
|
||||
\usepackage{hyperref} % PDF hyperlinks to a given page.
|
||||
|
||||
|
||||
|
||||
\hypersetup{hidelinks}
|
||||
\usepackage{tikz}
|
||||
|
||||
\catcode `č=13
|
||||
@ -99,5 +99,13 @@
|
||||
|
||||
|
||||
!solarij!
|
||||
\\ \\
|
||||
\begin{tikzpicture}
|
||||
\node (rect) [rectangle,fill = rumena, minimum width=175mm, minimum height=10mm] at (1,1) {};
|
||||
\node [above] at (rect.east) {\hspace*{-5.8cm} \textcolor{red}{Več v dokumentu UV sevanje in zdravje:}};
|
||||
\node [below] at (rect.east) {\hspace*{-7.3cm} \textcolor{blue}{\href{www.nijz.si/sl/ultravijolicno-uv-sevanje-in-zdravje}{www.nijz.si/sl/ultravijolicno-uv-sevanje-in-zdravje}}};
|
||||
\end{tikzpicture}
|
||||
|
||||
|
||||
\end{minipage}
|
||||
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user