may/1KA_F2F
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Barvanje Nijz report

Browse Source
This commit is contained in:
Miha 2021-11-04 21:21:09 +01:00
parent db9e8f50ee
commit 4a040cbf16
1 changed files with 19 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

31
admin/survey/modules/mod_NIJZ/R/Nijz_report.R
View File

@ -21,13 +21,16 @@ Sys.setlocale(category = "LC_ALL", locale = "slovenian")
params <- commandArgs(trailingOnly=TRUE) params <- commandArgs(trailingOnly=TRUE)
ID <- params[1] ID <- params[1]
#ID <- "26155472" #ID <- "26155472"
# Update za barvanje html in extract
library(rvest)
#------------- PASSING ARGUMENTS FROM CMD LINE ----------------# #------------- PASSING ARGUMENTS FROM CMD LINE ----------------#
#-------------------------- USER DEFINED FUNCTION ---------------------# #-------------------------- USER DEFINED FUNCTION ---------------------#
# Za potrebe pravilnega prikaza teksta v posameznih poglavjih # Za potrebe pravilnega prikaza teksta v posameznih poglavjih
lxTranslate <- function(x, color = "NE", pisava = TRUE, pikaklicaj = FALSE) { lxTranslate <- function(x, color = "NE", pisava = TRUE) {
x <- gsub("<strong>", "\\\\\\\\textbf{", x) x <- gsub("<strong>", "\\\\\\\\textbf{", x)
x <- gsub("<strong >", "\\\\\\\\textbf{", x)
x <- gsub("</strong>", "}", x) x <- gsub("</strong>", "}", x)
x <- x <-
gsub("<br /> <br />", "\\\\\\\\newline \\\\\\\\newline", x) gsub("<br /> <br />", "\\\\\\\\newline \\\\\\\\newline", x)
@ -38,24 +41,28 @@ lxTranslate <- function(x, color = "NE", pisava = TRUE, pikaklicaj = FALSE) {
x <- gsub("%", "\\\\\\\\%", x) x <- gsub("%", "\\\\\\\\%", x)
#x <- gsub("…", "\\\\\\\\dots", x)
#x <- gsub("…", "", x)
# ALI BNARVAMO? # ALI BNARVAMO?
if (color == "DA") { if (color == "DA") {
# Update, Potem pa želi NIJZ, da se prvi odstavek # Update, Potem pa želi NIJZ, da se prvi odstavek
# vedno obarva z "zeleno barvo, zaot moramo to # vedno obarva z "zeleno barvo, zaot moramo to
# utrezno ločiti # utrezno ločiti
if (pikaklicaj == FALSE) {
obarvajX <- stringr::str_extract(x, "[^.|!]+") # Najdi text z obravnajem zeleno
} else { obarvajX <- read_html(x) %>%
obarvajX <- stringr::str_extract(x, "[^!]+") html_nodes("span") %>%
html_text()
}
# DOdamo barvanje # DOdamo barvanje
obarvajX_1 <- paste0("{\\\\color{zelena}", obarvajX, "}") obarvajX_1 <- paste0("{\\\\color{zelena}",obarvajX , "}")
# Nadomestimo # Nadomestimo
x <- gsub(obarvajX, obarvajX_1, x, fixed=TRUE) # zamenja
x <- strsplit(x, "</span>", fixed =T)
x <- paste0(obarvajX_1, x[[1]][2])
} }
if (pisava == TRUE) { if (pisava == TRUE) {
val <- strsplit(x, "\\\\newline ", fixed =T)[[1]] val <- strsplit(x, "\\\\newline ", fixed =T)[[1]]
@ -410,7 +417,7 @@ oblacila <- lxTranslate(oblacila, color = "DA")
#------------------------ Poletni urnik za izvajanje aktivnosti na prostem ------------------------# #------------------------ Poletni urnik za izvajanje aktivnosti na prostem ------------------------#
solarij <- data %>% filter(str_detect(V1, "SOLARIJ")) %>% select(V2) solarij <- data %>% filter(str_detect(V1, "SOLARIJ")) %>% select(V2)
solarij <- lxTranslate(solarij, color = "DA", pikaklicaj = TRUE) solarij <- lxTranslate(solarij, color = "DA")
#--- #---