In itsdalmo/reporttool: Tools for reporting
# Replace entity ----------------------------------------------
entity <- "REPLACE_ENTITY"
# Package dependencies ---------------------------------------------------------
# Reading and manipulating data
suppressMessages(library(reporttool))
suppressMessages(library(dplyr))
suppressMessages(library(tidyr))
# Plotting
suppressMessages(library(ggplot2))
suppressMessages(library(grid))
suppressMessages(library(scales))
# Latex tables and string formatting
suppressMessages(library(xtable))
suppressMessages(library(stringi))
# Workbook (create and add open answers etc if needed) -------------------------
wb <- openxlsx::createWorkbook()
excel_only <- FALSE
# Get default values
latents <- get_default("latents")
palette <- get_default("palette")
palette <- c("#2FABB7", "#F04E36", "#747678", "#4C72B0", "#55A868", "#C44E52", "#8172B2", "#CCB974", "#FFC000", "#004A52", "#0091A1", "#BFBFBF")
# Get model questions
questions <- tbl_df(srv$mm) %>%
select(latent, manifest) %>%
filter(latent %in% get_default("latents")) %>%
mutate(latent = factor(latent, levels = get_default("latents"))) %>%
arrange(latent)
# Wrapper for stri_wrap
simple_wrap <- function(x, width) {
x <- stri_wrap(as.character(x), width = width, simplify = FALSE)
vapply(x, stri_c, collapse = "\n", character(1))
}
# Small function to make some colors fixed
fixed_colors <- function(colors, entities) {
c(colors[!is.na(names(colors))], setNames(colors[is.na(names(colors))], setdiff(entities, names(colors))))
}
# Prepare survey (replace and lowercase columnnames)
srv <- prepare_survey(srv)
# Figure out which slides should be included
subentity <- "subentity" %in% names(srv$df) && nrow(filter(srv$df, mainentity %in% entity, !is.na(subentity))) > 0L
historical <- nrow(srv$hd) > 0L && "mainentity" %in% names(srv$hd) && entity %in% srv$hd$mainentity
complaint <- length(get_association(srv, "complaint")) > 0
complaint_handeling <- length(get_association(srv, "complaint_handling")) > 0
open_answers <- length(get_association(srv, c("open_complaint", "open_answer"))) > 0
# Collect information on the survey --------------------------------------------
info <- list()
# Dates
if (any(srv$mm$type == "Date")) {
dvar <- filter(srv$mm, type == "Date") %>% select(manifest)
dvar <- dvar$manifest[1] # In case there is more than 1 variable
# Get min and max date, month and year
info$start <- format(min(srv$df[[dvar]], na.rm = TRUE), "%e. %b. %Y")
info$end <- format(max(srv$df[[dvar]], na.rm = TRUE), "%e. %b. %Y")
info$month <- format(min(srv$df[[dvar]], na.rm = TRUE), "%e. %b. %Y")
info$year <- format(min(srv$df[[dvar]], na.rm = TRUE), "%Y")
# Infer period from month and add translation
info$period <- ifelse(info$month <= 6,
get_translation(srv, "spring"),
get_translation(srv, "fall"))
info$period <- stri_c(info$period, info$year, sep = " ")
}
# Response information ---------------------------------------------------------
info$respondents <- srv$ents$n[srv$ents$entity %in% entity]
info$valid <- srv$ents$valid[srv$ents$entity %in% entity]
info$valid_percent <- info$valid/info$respondents
# Number of latents and model questions ----------------------------------------
info$questions <- nrow(questions)
# Model question scores --------------------------------------------------------
model_scores <- srv %>%
group_by(mainentity) %>%
survey_table(one_of(stri_c(questions$manifest, "em")), wide = FALSE) %>%
select(-n) %>%
mutate(manifest = stri_replace(manifest, "$1", regex = "(.*)em$"))
model_scores <- model_scores %>%
left_join(questions, by = c("manifest" = "manifest")) %>%
arrange(latent) %>%
mutate(manifest = stri_trans_totitle(manifest)) %>%
mutate(manifest = factor(manifest, levels = stri_trans_totitle(questions$manifest)))
# Latent scores ----------------------------------------------------------------
latent_scores <- srv %>%
group_by(mainentity) %>%
survey_table(one_of(get_default("latents")), wide = FALSE)
# Fixed colors -----------------------------------------------------------------
palette <- setNames(palette, c(entity, as.character(latent_scores$mainentity)[length(latent_scores$mainentity)]))
Forord
Gjennomføring
- Målgruppen for denne undersøkelsen er foreldre med barn i
r entity.
- Svarene er avgitt på web (Research.net^1) i perioden
r info$start til r info$end.
- Respondentene (de som er invitert til å delta) kan motta inntil 3 e-poster - hvorav den første er en standard utsendelse, samt 2 påminnelser til de som ikke svarte på den første utsendelsen og evt. den første påminnelsen.
- Totalt antall gyldige svar som ligger til grunn for denne rapporten:
r info$valid
- Det er hentet inn svar på
r info$questions spørsmål som bygger opp under hovedanalysen. I tillegg til dette så har det vært stilt bakgrunnsspørsmål som bidrar med ytterligere innsikt i forhold til kundeopplevelsen.
- Alle resultatene som presenteres i denne rapporten er overlevert for intern bruk i
r entity, og dere står selv fritt til å dele resultatene med andre.
- EPSIs nasjonale studie av barnehage er en separat studie, og resultatene som formidles via EPSIs hjemmesider^2 kan fritt siteres.
- Enkelte resultater fra den nasjonale studien (Snitt nasjonal) er inkludert i denne rapporten.
Skala og svar
- Indeksen for kundetilfredshet presenteres som en verdi mellom 0 og 100, og er det sentrale målet i disse målingene. Dette er en indeksverdi, ikke en prosentverdi. Jo høyere verdi desto bedre anser kundene (de foresatte) deres krav og forventninger oppfylles.
- Spørsmålene svares på en skala fra 1 til 10, hvor 1 betyr "svært misfornøyd" eller "helt uenig" og hvor 10 betyr "svært fornøyd" eller "helt enig".
-
Resultatene gjøres i etterkant om til en 100-punkts skala.
-
Som en generell regel kan man si at:
- Målinger under 60 er lavt/veldig lavt
- Målinger fra 60 - 75 er gjennomsnittlig
- Målinger over 75 anses som høyt/veldig høyt
-
Se www.epsi-norway.org for mer informasjon om metode og modell, eller om EPSI for øvrig.
Aspekter i EPSI modellen
-
r get_translation(srv, "image") (r conjunct_string(stri_trans_totitle(get_association(srv, "image")), "og")) er målt for å fange hvilket inntrykk foreldrene har av r entity, basert på det de har hørt og lest.
-
r get_translation(srv, "expect") (r conjunct_string(stri_trans_totitle(get_association(srv, "expect")), "og")) er et mål på hva foreldrene forventer å få ut av kundeforholdet.
-
r get_translation(srv, "prodq") (r conjunct_string(stri_trans_totitle(get_association(srv, "prodq")), "og")) fanger foreldrenes opplevelse av tjeneste- og produkttilbudet.
-
r get_translation(srv, "servq") (r conjunct_string(stri_trans_totitle(get_association(srv, "servq")), "og")) har fokus på det generelle servicenivået sett fra foreldrenes ståsted.
-
r get_translation(srv, "value") (r conjunct_string(stri_trans_totitle(get_association(srv, "value")), "og")) er utformet for å fange opp forholdet mellom hva som er oppnådd (levert) og prisen / kostnaden for å få dette, sett fra foreldrenes ståsted.
-
r get_translation(srv, "epsi") (KTI) er det sentrale målet i modellen, og reflekterer hvorvidt foreldrene opplever at deres krav og forventninger blir oppfylt. Resultatet for barnehagen beregnes på bakgrunn av r length(get_association(srv, "epsi")) spørsmål (r conjunct_string(stri_trans_totitle(get_association(srv, "epsi")), "og")).
-
r get_translation(srv, "loyal") (r conjunct_string(stri_trans_totitle(get_association(srv, "loyal")), "og")) måler eksempelvis hvorvidt foreldrene ville valgt samme barnehage dersom vedkommende måtte velge på nytt. Forskning viser at lojalitet i stor grad er påvirket av kundetilfredsheten.
-
Generelt så er det viktig med en balanse mellom forventninger og opplevd kvalitet (selve leveransen). Med andre ord, dersom gapet mellom hva foreldrene forventer og hvordan de opplever kvaliteten (negativt gap) blir for stor, så vil det ha negativ betydning for tilfredsheten.
-
NB: I spørsmålsteksten er {XX} benyttet som en plassholder. Da foreldrene svarte på undersøkelsen ble dette feltet byttet ut med navnet på barnehagen (altså r entity).
Kundeprofil for r entity
# Frametitle -------------------------------------------------------------------
cat("##", "","\n", sep=" ")
# Use survey_table to collect the data
pd <- latent_scores %>%
filter(mainentity %in% c(entity, get_translation(srv, c("study_average", "contrast_average")))) %>%
select(-n, -manifest)
# Get the vertical justification for geom text ---------------------------------
vjust <- pd %>% spread(mainentity, answer)
vjust$overlap <- if (ncol(vjust) > 3) rowMeans(vjust[, 2:ncol(vjust)]) else vjust[[ncol(vjust)]]
vjust <- ifelse(vjust[[entity]] < vjust[["overlap"]], -1.5, 1.5)
# Calculate appropriate range for y-axis ---------------------------------------
y_max <- ifelse(max(pd[["answer"]]) < 90, round(max(pd[["answer"]])+10, -1), 100)
y_min <- ifelse(min(pd[["answer"]]) > 10, round(min(pd[["answer"]])-10, -1), 0)
# Create the profile-plot ------------------------------------------------------
p <- ggplot(data=pd, aes(x=question, y=answer, group=mainentity, colour=mainentity))
p + geom_line(size=1) +
geom_point(size=3) +
scale_color_manual(values = fixed_colors(palette, as.character(pd$mainentity))) +
geom_text(data = filter(pd, mainentity == entity),
aes(label=sprintf("%.1f", answer)),
size=4, colour="#23373b", vjust=.5, nudge_y=vjust) +
ylim(y_min, y_max) +
guides(linetype=FALSE) +
plot_theme()
# Title and subtitle -----------------------------------------------------------
cat("#", "Kundeprofil per", get_translation(srv, "subentity"), "\n", sep = " ")
cat("##", "","\n", sep=" ")
# Use survey_table to collect the data
pd <- srv %>%
filter(mainentity %in% entity, !is.na(subentity)) %>%
mutate(subentity = factor(subentity)) %>%
group_by(subentity) %>%
survey_table(one_of(get_default("latents")), wide = FALSE, contrast = FALSE) %>%
mutate(subentity = ifelse(subentity %in% get_translation(srv, "study_average"), "Snitt", as.character(subentity))) %>%
mutate(subentity = factor(stri_trans_totitle(subentity), levels = stri_trans_totitle(unique(subentity)))) %>%
select(-n, -manifest)
# Get the vertical justification for geom text ---------------------------------
vjust <- pd %>% spread(subentity, answer)
vjust$overlap <- if (ncol(vjust) > 3) rowMeans(vjust[, 2:ncol(vjust)]) else vjust[[ncol(vjust)]]
vjust <- ifelse(vjust[["Snitt"]] < vjust[["overlap"]], -1.5, 1.5)
# Calculate appropriate range for y-axis ---------------------------------------
y_max <- ifelse(max(pd[["answer"]]) < 90, round(max(pd[["answer"]])+10, -1), 100)
y_min <- ifelse(min(pd[["answer"]]) > 10, round(min(pd[["answer"]])-10, -1), 0)
# Add linetypes
pd <- pd %>% mutate(line = ifelse(subentity == "Snitt", "solid", "dashed"))
# Create the profile-plot ------------------------------------------------------
p <- ggplot(data=pd, aes(x=question, y=answer, group=subentity, colour=subentity, linetype = line))
p + geom_line(size=1) +
geom_point(size=3) +
scale_color_manual(values = fixed_colors(setNames(palette, c(entity, "Snitt")), pd$subentity)) +
geom_text(data = filter(pd, subentity == "Snitt"),
aes(label=sprintf("%.1f", answer)),
size=4, colour="#23373b", vjust=.5, nudge_y=vjust) +
ylim(y_min, y_max) +
guides(linetype=FALSE, color=guide_legend(nrow=2, byrow=TRUE)) +
plot_theme()
# Frametitle -------------------------------------------------------------------
cat("# Historikk\n")
cat("##", "","\n", sep=" ")
csemester <- "fall"; cyear <- 2015
# Use survey_table to collect the data
pd <- latent_scores %>%
filter(mainentity %in% entity) %>%
select(-n, -question) %>%
spread(manifest, answer) %>%
mutate(year = cyear, semester = csemester)
# Add the historical data
transl <- setNames(c("spring", "fall"), get_translation(srv, c("spring", "fall")))
pd <- bind_rows(pd, srv$hd %>% filter(mainentity == entity)) %>%
arrange(desc(year), semester) %>%
mutate(semester = ordered_replace(semester, transl), mainentity = stri_c(semester, year, sep = " "))
# Convert to long format and replace names
transl <- setNames(get_default("latents"), get_translation(srv, get_default("latents")))
pd <- pd %>%
select(-semester, -year) %>%
gather(question, answer, -mainentity) %>%
filter(question %in% c("epsi", "loyal")) %>%
mutate(question = ordered_replace(as.character(question), transl)) %>%
mutate(question = factor(question, names(transl), ordered = TRUE)) %>%
mutate(mainentity = factor(mainentity, levels = unique(mainentity), ordered = TRUE))
# Calculate appropriate range for y-axis ---------------------------------------
y_max <- ifelse(max(pd[["answer"]]) < 90, round(max(pd[["answer"]])+10, -1), 100)
y_min <- ifelse(min(pd[["answer"]]) > 10, round(min(pd[["answer"]])-10, -1), 0)
# Create the profile-plot ------------------------------------------------------
p <- ggplot(data=pd, aes(x=question, y=answer, group=mainentity, fill=mainentity))
p + geom_bar(stat="identity", width=0.5, position=position_dodge(width=0.6)) +
scale_y_continuous(limits=c(y_min, y_max), oob = rescale_none) +
#coord_cartesian(ylim = c(y_min, y_max)) +
scale_fill_manual(values = setNames(palette, unique(pd$mainentity))) +
geom_text(aes(label=sprintf("%.1f", answer)),
size=3, colour="#23373b", position=position_dodge(width=0.6), vjust=-1.1, hjust=.35) +
guides(fill = guide_legend(keywidth = .5, keyheight = .5)) +
plot_theme() +
theme(title = element_text(hjust = -.1))
GAP-analyse
# Frametitle -------------------------------------------------------------------
if (get_translation(srv, "contrast_average") %in% model_scores$mainentity) {
cat("##", "Differansen mellom", entity, "og", get_translation(srv, "contrast_average"),"\n", sep=" ")
} else {
cat("##", "Differansen mellom", entity, "og", get_translation(srv, "study_average"),"\n", sep=" ")
}
# Gather the data
pd <- model_scores %>%
filter(mainentity %in% c(entity, get_translation(srv, c("contrast_average", "study_average"))))
# Calculate the difference between the entity and the average ------------------
pd <- pd %>% spread(mainentity, answer) %>% arrange(latent)
pd$difference <- pd[[4]] - pd[[5]]
# Shorten the strings and insert them into the data ----------------------------
text <- as.character(pd$question)
text <- ifelse(stri_length(text) >= 90, stri_c(stri_sub(text, to = 90-3), "..."), text)
pd$question <- text
# Ready the data for plotting --------------------------------------------------
pd <- pd %>%
select(manifest, question, difference) %>%
mutate("sign" = ifelse(difference > 0, 1, 0)) %>%
mutate(sign = factor(sign, levels=unique(sign))) %>%
mutate(question = stri_c(manifest, question, sep = " - ")) %>%
mutate(question = factor(question, levels=rev(unique(question))))
# Calculate appropriate range for y-axis ---------------------------------------
y_min <- 5*floor(min(pd$difference, na.rm=TRUE)/4)
y_max <- 5*ceiling(max(pd$difference, na.rm=TRUE)/4)
# Create the plot --------------------------------------------------------------
p <- ggplot(data=pd, aes(x=question, y=difference, fill=sign))
p + geom_bar(stat="identity", width=0.5, position="dodge") +
coord_flip(ylim = c(y_min, y_max)) +
scale_fill_manual(values=setNames(palette, c(1,0))) +
geom_hline(yintercept=0, size=.5, colour = "#D0D0D0") +
geom_text(data = filter(pd, sign == 1),
aes(label=sprintf("%.1f", difference)),
size=3, colour="#23373b", vjust=.2, hjust=-.55) +
geom_text(data = filter(pd, sign == 0),
aes(label=sprintf("%.1f", difference)),
size=3, colour="#23373b", vjust=.3, hjust=+1.5) +
plot_theme(legend="none") +
theme(plot.margin = unit(c(1, 1.5, 0.5, 0.5), "lines"),
axis.text.x = element_text(angle = 45, hjust = 1),
panel.grid = element_blank())
Resultat per spørsmål
# Frametitle -------------------------------------------------------------------
cat("##", "","\n", sep=" ")
# Gather the data
pd <- model_scores %>%
filter(mainentity %in% c(entity, get_translation(srv, c("contrast_average", "study_average"))))
# Calculate the difference between the entity and the average ------------------
if (length(levels(pd$mainentity)) > 1L) {
pd <- pd %>% spread(mainentity, answer) %>% arrange(manifest)
pd$difference <- pd[[4]] - pd[[5]]
}
# Replace headers with the translation from config -----------------------------
names(pd) <- ordered_replace(names(pd), setNames(srv$tr$original, srv$tr$replacement))
# Get length of column headers for the table, and truncate manifest text if needed:
max_length <- 110 - 2*length(names(pd)) - sum(stri_length(names(pd)[-2]))
max_length <- floor(max_length/5)*5
min_length <- stri_length(get_translation(srv, "question"))
max_length <- if (max_length < min_length) min_length else max_length
# Shorten the strings and insert them into the data ----------------------------
text <- as.character(pd[[get_translation(srv, "question")]])
text <- ifelse(stri_length(text) >= max_length, stri_c(stri_sub(text, to = max_length-3), "..."), text)
pd[[get_translation(srv, "question")]] <- text
# Divide the data for the two tables -------------------------------------------
first_table <- filter(pd, latent %in% latents[1:3]) %>% select(-latent) %>% xtable(digits=1)
second_table <- filter(pd, latent %in% latents[4:length(latents)]) %>% select(-latent) %>% xtable(digits=1)
# Capture output and alter to color negative values in red ---------------------
first_table <- capture.output(print.xtable(first_table, size="\\tiny", comment=F, include.rownames=F))
second_table <- capture.output(print.xtable(second_table, size="\\tiny", comment=F, include.rownames=F))
first_table <- stri_replace_all(first_table, "$1\\\\textcolor[HTML]{D2232B}{$2}", regex = "(\\s|^)(-\\d?\\d\\.\\d*)")
second_table <- stri_replace_all(second_table, "$1\\\\textcolor[HTML]{D2232B}{$2}", regex = "(\\s|^)(-\\d?\\d\\.\\d*)")
# Print the first table --------------------------------------------------------
cat(first_table, sep="\n")
# Frametitle -------------------------------------------------------------------
cat("##", "","\n", sep=" ")
cat(second_table, sep="\n")
Flowchart
# Frametitle -------------------------------------------------------------------
cat("##", "\n", sep=" ")
weights <- srv$inner_weights %>%
mutate(origin = stri_trans_tolower(origin)) %>%
filter(mainentity == entity, !origin %in% "loyal") %>%
select(-image) %>%
gather(target, weight, -mainentity, -origin) %>%
filter(!(origin == target),
!(origin == "image" & target %in% c("value", "loyal")),
!(origin == "expect" & target %in% c("value", "epsi", "loyal")),
!(origin == "prodq" & target %in% c("expect", "loyal")),
!(origin == "servq" & target %in% c("expect", "prodq", "loyal")),
!(origin == "value" & target %in% c("expect", "prodq", "servq", "loyal")),
!(origin == "epsi" & target != "loyal")) %>%
mutate(origin = factor(origin, levels = get_default("latents"), ordered = TRUE)) %>%
arrange(origin) %>%
mutate(latent = stri_c(stri_c(origin, "_"), target)) %>%
select(latent, weight)
scores <- latent_scores %>% filter(mainentity == entity)
nms <- get_translation(srv, get_default("latents"))
p <- flowchart(scores$answer, weights$weight, nms)
p + annotate("rect", xmin = .3, xmax = 5.25, ymin = 0, ymax = 10, alpha = .1, fill = palette[1]) +
annotate("text", x = 4.93, y = 0.2, label = "Drivere", size = 3, colour = "#23373b", fontface = "bold")
# Add footnote -----------------------------------------------------------------
footnote <- stri_c("Pilene i flytdiagrammet viser sammenhengen mellom aspektene vi har målt, og deres effekt på hverandre.
Effekten beskrives med et tall mellom 0 og 1, og jo høyere verdi (nærmere 1) dess tettere sammenheng.")
cat("\\footnoteextra{", footnote, "}", sep = "")
Effekt på kundetilfredshet
# Frametitle -------------------------------------------------------------------
cat("##", "", "\n", sep=" ")
# Gather the data for the table ------------------------------------------------
pd <- srv$outer_weights %>%
filter(mainentity == entity) %>%
select(latent, manifest, question, epsi_effect) %>%
arrange(desc(epsi_effect)) %>%
mutate(manifest = stri_trans_totitle(manifest), latent = stri_trans_totitle(latent))
# Replace headers with the translation from config -----------------------------
names(pd) <- ordered_replace(names(pd), setNames(srv$tr$original, srv$tr$replacement))
names(pd)[c(1, 4)] <- c("Aspekt", "Effekt")
# Get length of column headers for the table, and truncate manifest text if needed:
max_length <- 110 - 2*length(names(pd)) - sum(stri_length(names(pd)[-2]))
max_length <- floor(max_length/5)*5
min_length <- stri_length(get_translation(srv, "question"))
max_length <- if (max_length < min_length) min_length else max_length
# Shorten the strings and insert them into the data ----------------------------
text <- as.character(pd[[get_translation(srv, "question")]])
text <- ifelse(stri_length(text) >= max_length, stri_c(stri_sub(text, to = max_length-3), "..."), text)
pd[[get_translation(srv, "question")]] <- text
# Divide the data for the two tables -------------------------------------------
first_table <- pd %>% xtable(digits=2)
# Capture output and alter to color negative values in red ---------------------
first_table <- capture.output(print.xtable(first_table, size="\\tiny", comment=F, include.rownames=F))
# Print the first table --------------------------------------------------------
cat(first_table, sep="\n")
# Add footnote -----------------------------------------------------------------
footnote <- "Spørsmålene i tabellen over er sortert etter viktighet. Tabellen leses slik at dersom resultatet på ett enkelt spørsmål øker med 0,5 enhet på en 1-10 skala, så vil kundetilfredsheten øke med det som står i 'effekt' (på en 100 punkts skala)."
cat("\\footnoteextra{", footnote, "}", sep = "")
Kontakt og service
# Frametitle -------------------------------------------------------------------
cat("##", get_question(srv, "q7_service"), "\n", sep = " ")
# Gather the data for the table ------------------------------------------------
pd <- srv %>%
group_by(mainentity) %>%
survey_table(q7_service, wide = FALSE) %>%
filter(mainentity %in% c(entity, get_translation(srv, c("contrast_average", "study_average")))) %>%
mutate(mainentity = factor(mainentity))
# Create the plot --------------------------------------------------------------
p <- ggplot(pd, aes(x=answer, y=proportion, fill=mainentity, group=mainentity, ymin=0, ymax=1))
p + geom_bar(stat="identity", width=0.5, position=position_dodge(width=0.6)) +
scale_fill_manual(values=fixed_colors(palette, pd$mainentity), drop=FALSE) +
scale_x_discrete(labels = function(x) simple_wrap(x, 15)) +
scale_y_continuous(labels=percent) +
geom_text(aes(label=sprintf("%.0f%%", proportion*100)),
size=3, colour="#23373b", position=position_dodge(width=0.6), vjust=-1.1, hjust=.35) +
guides(fill = guide_legend(keywidth = .5, keyheight = .5)) +
plot_theme() +
theme(title = element_text(hjust = -.1))
cat("##", "Sist du kontaktet {XX}, hvordan opplevde du...", "\n", sep = " ")
# Gather the data
pd <- srv %>%
mutate_each(funs(rescale_score(clean_score(.))), q7sd:q7sf) %>%
group_by(mainentity) %>%
survey_table(q7sd:q7sf, wide = FALSE) %>%
select(-n) %>%
filter(mainentity %in% c(entity, get_translation(srv, c("contrast_average", "study_average")))) %>%
mutate(mainentity = factor(mainentity)) # Drop unused levels
# Calculate appropriate range for y-axis ---------------------------------------
y_max <- ifelse(max(pd[["answer"]]) < 90, round(max(pd[["answer"]])+10, -1), 100)
y_min <- ifelse(min(pd[["answer"]]) > 10, round(min(pd[["answer"]])-10, -1), 0)
# Plot the data
p <- ggplot(pd, aes(x=question, y=answer, fill=mainentity, group=mainentity, ymin=0, ymax=100))
p + geom_bar(stat="identity", width=0.5, position=position_dodge(width=0.6)) +
scale_fill_manual(values=fixed_colors(palette, pd$mainentity), drop=FALSE) +
scale_y_continuous(limits=c(y_min, y_max), oob = rescale_none) +
scale_x_discrete(labels = function(x) simple_wrap(x, 25)) +
geom_text(aes(label=sprintf("%.1f", answer)),
size=3, colour="#23373b", position=position_dodge(width=0.6), vjust=-1.1, hjust=.35) +
guides(fill = guide_legend(keywidth = .5, keyheight = .5)) +
plot_theme() +
theme(panel.margin = unit(2, "lines"))
# Frametitle -------------------------------------------------------------------
cat("# Klager\n")
cat("##", "\n", sep = " ")
# Create the first plot --------------------------------------------------------
mvar <- get_association(srv, "complaint")
pd <- srv %>%
group_by(mainentity) %>%
survey_table_(dots = mvar, wide = FALSE) %>%
filter(mainentity %in% c(entity, get_translation(srv, c("contrast_average", "study_average")))) %>%
mutate(mainentity = factor(mainentity))
p1 <- ggplot(pd, aes(x=answer, y=proportion, fill=mainentity, group=mainentity, ymin=0, ymax=1))
p1 <- p1 + geom_bar(stat="identity", width=0.5, position=position_dodge(width=0.6)) +
scale_fill_manual(values=fixed_colors(palette, pd$mainentity), drop=FALSE) +
scale_x_discrete(labels = function(x) simple_wrap(x, 25)) +
scale_y_continuous(labels=percent) +
geom_text(aes(label=sprintf("%.0f%%", proportion*100)),
size=3, colour="#23373b", position=position_dodge(width=0.6), vjust=-1.1, hjust=.35) +
guides(fill = guide_legend(keywidth = .5, keyheight = .5)) +
plot_theme() +
theme(title = element_text(hjust = 0, size = 10)) +
ggtitle(get_question(srv, mvar))
# Create the second plot --------------------------------------------------------
mvar <- get_association(srv, "complaint_handling")
call_recode <- lazyeval::interp(
~recode(clean_score(x), as_factor = TRUE, "Lite fornøyd (1-5)" = 1:5L, "Middels (6-8)" = 6:8L, "Svært fornøyd (9-10)" = 9:10L), x = as.name(mvar))
pd <- srv %>%
mutate_(.dots = setNames(list(call_recode), mvar)) %>%
group_by(mainentity) %>%
survey_table_(dots = mvar, wide = FALSE) %>%
filter(mainentity %in% c(entity, get_translation(srv, c("contrast_average", "study_average")))) %>%
mutate(mainentity = factor(mainentity))
p2 <- ggplot(pd, aes(x=answer, y=proportion, fill=mainentity, group=mainentity, ymin=0, ymax=1.05))
p2 <- p2 + geom_bar(stat="identity", width=0.5, position=position_dodge(width=0.6)) +
scale_fill_manual(values=fixed_colors(palette, pd$mainentity), drop=FALSE) +
scale_x_discrete(labels = function(x) simple_wrap(x, 25)) +
scale_y_continuous(labels=percent) +
geom_text(aes(label=sprintf("%.0f%%", proportion*100)),
size=3, colour="#23373b", position=position_dodge(width=0.6), vjust=-1.1, hjust=.35) +
guides(fill = guide_legend(keywidth = .5, keyheight = .5)) +
plot_theme() +
theme(title = element_text(hjust = 0, size = 10)) +
ggtitle(get_question(srv, mvar))
# Plot both plots with shared legend
plot_shared_legend(p1, p2)
Åpne svar
# Frametitle -------------------------------------------------------------------
mvar <- get_association(srv, c("open_complaint", "open_answer"))
frametitle <- stri_c("##", get_question(srv, mvar), "(uredigerte svar)", sep = " ")
pd <- get_data(srv) %>%
select(mainentity, one_of(mvar)) %>%
filter(mainentity == entity) %>%
gather(var, answers, -mainentity) %>%
mutate(answers = clean_text(answers)) %>%
mutate(title = ordered_replace(as.character(var), mvar, frametitle)) %>%
filter(!is.na(answers))
lines <- stri_wrap(pd$answers, width = 135L, whitespace_only = TRUE, simplify = FALSE)
lines <- vapply(lines, length, numeric(1))
pd <- pd %>%
mutate(nlines = lines) %>%
group_by(var) %>%
mutate(tlines = cumsum(nlines)) %>%
mutate(page = findInterval(tlines, vec = if (max(tlines) > 23) seq(1, max(tlines), 22) else 1L))
# Inform if no answers were found ----------------------------------------------
for (i in levels(pd$var)) {
pdd <- filter(ungroup(pd), var == i)
ftt <- pdd$title[1]
if (nrow(pd) == 0) {
cat(ftt, "Ingen årsaker oppgitt av respondentene.", sep = "\n")
# Write to sheet if text is too long (>10 pages) ------------------------------
} else if (ceiling(sum(pd$nlines)/23) > 10 || excel_only) {
cat(ftt, "Se vedlagt regneark i Excel format.\n", sep = "\n")
pdd %>% mutate(answers = stri_replace(answers, "", regex = "^- ")) %>%
select("Svar" = answers) %>%
to_sheet(wb, title = stri_replace(ftt, "", regex = "^##"), sheet = i)
# Print the results ----------------------------------------------------------
} else {
for (ii in unique(pdd$page)) { cat(ftt, pdd$answers[pdd$page == ii], "\n", sep = "\n") }
}
}
# Make sure changes to WB are registered ---------------------------------------
wb <- wb
# Write the wb if necessary ----------------------------------------------------
if (length(openxlsx::sheets(wb))) {
openxlsx::saveWorkbook(wb, stri_c("../Reports/", entity, " - åpne svar.xlsx"), overwrite = TRUE)
}
itsdalmo/reporttool documentation built on May 18, 2019, 7:11 a.m.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
# Replace entity ---------------------------------------------- entity <- "REPLACE_ENTITY" # Package dependencies --------------------------------------------------------- # Reading and manipulating data suppressMessages(library(reporttool)) suppressMessages(library(dplyr)) suppressMessages(library(tidyr)) # Plotting suppressMessages(library(ggplot2)) suppressMessages(library(grid)) suppressMessages(library(scales)) # Latex tables and string formatting suppressMessages(library(xtable)) suppressMessages(library(stringi)) # Workbook (create and add open answers etc if needed) ------------------------- wb <- openxlsx::createWorkbook() excel_only <- FALSE # Get default values latents <- get_default("latents") palette <- get_default("palette") palette <- c("#2FABB7", "#F04E36", "#747678", "#4C72B0", "#55A868", "#C44E52", "#8172B2", "#CCB974", "#FFC000", "#004A52", "#0091A1", "#BFBFBF") # Get model questions questions <- tbl_df(srv$mm) %>% select(latent, manifest) %>% filter(latent %in% get_default("latents")) %>% mutate(latent = factor(latent, levels = get_default("latents"))) %>% arrange(latent) # Wrapper for stri_wrap simple_wrap <- function(x, width) { x <- stri_wrap(as.character(x), width = width, simplify = FALSE) vapply(x, stri_c, collapse = "\n", character(1)) } # Small function to make some colors fixed fixed_colors <- function(colors, entities) { c(colors[!is.na(names(colors))], setNames(colors[is.na(names(colors))], setdiff(entities, names(colors)))) } # Prepare survey (replace and lowercase columnnames) srv <- prepare_survey(srv) # Figure out which slides should be included subentity <- "subentity" %in% names(srv$df) && nrow(filter(srv$df, mainentity %in% entity, !is.na(subentity))) > 0L historical <- nrow(srv$hd) > 0L && "mainentity" %in% names(srv$hd) && entity %in% srv$hd$mainentity complaint <- length(get_association(srv, "complaint")) > 0 complaint_handeling <- length(get_association(srv, "complaint_handling")) > 0 open_answers <- length(get_association(srv, c("open_complaint", "open_answer"))) > 0
# Collect information on the survey -------------------------------------------- info <- list() # Dates if (any(srv$mm$type == "Date")) { dvar <- filter(srv$mm, type == "Date") %>% select(manifest) dvar <- dvar$manifest[1] # In case there is more than 1 variable # Get min and max date, month and year info$start <- format(min(srv$df[[dvar]], na.rm = TRUE), "%e. %b. %Y") info$end <- format(max(srv$df[[dvar]], na.rm = TRUE), "%e. %b. %Y") info$month <- format(min(srv$df[[dvar]], na.rm = TRUE), "%e. %b. %Y") info$year <- format(min(srv$df[[dvar]], na.rm = TRUE), "%Y") # Infer period from month and add translation info$period <- ifelse(info$month <= 6, get_translation(srv, "spring"), get_translation(srv, "fall")) info$period <- stri_c(info$period, info$year, sep = " ") } # Response information --------------------------------------------------------- info$respondents <- srv$ents$n[srv$ents$entity %in% entity] info$valid <- srv$ents$valid[srv$ents$entity %in% entity] info$valid_percent <- info$valid/info$respondents # Number of latents and model questions ---------------------------------------- info$questions <- nrow(questions) # Model question scores -------------------------------------------------------- model_scores <- srv %>% group_by(mainentity) %>% survey_table(one_of(stri_c(questions$manifest, "em")), wide = FALSE) %>% select(-n) %>% mutate(manifest = stri_replace(manifest, "$1", regex = "(.*)em$")) model_scores <- model_scores %>% left_join(questions, by = c("manifest" = "manifest")) %>% arrange(latent) %>% mutate(manifest = stri_trans_totitle(manifest)) %>% mutate(manifest = factor(manifest, levels = stri_trans_totitle(questions$manifest))) # Latent scores ---------------------------------------------------------------- latent_scores <- srv %>% group_by(mainentity) %>% survey_table(one_of(get_default("latents")), wide = FALSE) # Fixed colors ----------------------------------------------------------------- palette <- setNames(palette, c(entity, as.character(latent_scores$mainentity)[length(latent_scores$mainentity)]))
Forord
Gjennomføring
- Målgruppen for denne undersøkelsen er foreldre med barn i
r entity. - Svarene er avgitt på web (Research.net^1) i perioden
r info$starttilr info$end. - Respondentene (de som er invitert til å delta) kan motta inntil 3 e-poster - hvorav den første er en standard utsendelse, samt 2 påminnelser til de som ikke svarte på den første utsendelsen og evt. den første påminnelsen.
- Totalt antall gyldige svar som ligger til grunn for denne rapporten:
r info$valid - Det er hentet inn svar på
r info$questionsspørsmål som bygger opp under hovedanalysen. I tillegg til dette så har det vært stilt bakgrunnsspørsmål som bidrar med ytterligere innsikt i forhold til kundeopplevelsen. - Alle resultatene som presenteres i denne rapporten er overlevert for intern bruk i
r entity, og dere står selv fritt til å dele resultatene med andre. - EPSIs nasjonale studie av barnehage er en separat studie, og resultatene som formidles via EPSIs hjemmesider^2 kan fritt siteres.
- Enkelte resultater fra den nasjonale studien (Snitt nasjonal) er inkludert i denne rapporten.
Skala og svar
- Indeksen for kundetilfredshet presenteres som en verdi mellom 0 og 100, og er det sentrale målet i disse målingene. Dette er en indeksverdi, ikke en prosentverdi. Jo høyere verdi desto bedre anser kundene (de foresatte) deres krav og forventninger oppfylles.
- Spørsmålene svares på en skala fra 1 til 10, hvor 1 betyr "svært misfornøyd" eller "helt uenig" og hvor 10 betyr "svært fornøyd" eller "helt enig".
-
Resultatene gjøres i etterkant om til en 100-punkts skala.
-
Som en generell regel kan man si at:
- Målinger under 60 er lavt/veldig lavt
- Målinger fra 60 - 75 er gjennomsnittlig
- Målinger over 75 anses som høyt/veldig høyt
-
Se www.epsi-norway.org for mer informasjon om metode og modell, eller om EPSI for øvrig.
Aspekter i EPSI modellen
-
r get_translation(srv, "image")(r conjunct_string(stri_trans_totitle(get_association(srv, "image")), "og")) er målt for å fange hvilket inntrykk foreldrene har avr entity, basert på det de har hørt og lest. -
r get_translation(srv, "expect")(r conjunct_string(stri_trans_totitle(get_association(srv, "expect")), "og")) er et mål på hva foreldrene forventer å få ut av kundeforholdet. -
r get_translation(srv, "prodq")(r conjunct_string(stri_trans_totitle(get_association(srv, "prodq")), "og")) fanger foreldrenes opplevelse av tjeneste- og produkttilbudet. -
r get_translation(srv, "servq")(r conjunct_string(stri_trans_totitle(get_association(srv, "servq")), "og")) har fokus på det generelle servicenivået sett fra foreldrenes ståsted. -
r get_translation(srv, "value")(r conjunct_string(stri_trans_totitle(get_association(srv, "value")), "og")) er utformet for å fange opp forholdet mellom hva som er oppnådd (levert) og prisen / kostnaden for å få dette, sett fra foreldrenes ståsted. -
r get_translation(srv, "epsi")(KTI) er det sentrale målet i modellen, og reflekterer hvorvidt foreldrene opplever at deres krav og forventninger blir oppfylt. Resultatet for barnehagen beregnes på bakgrunn avr length(get_association(srv, "epsi"))spørsmål (r conjunct_string(stri_trans_totitle(get_association(srv, "epsi")), "og")). -
r get_translation(srv, "loyal")(r conjunct_string(stri_trans_totitle(get_association(srv, "loyal")), "og")) måler eksempelvis hvorvidt foreldrene ville valgt samme barnehage dersom vedkommende måtte velge på nytt. Forskning viser at lojalitet i stor grad er påvirket av kundetilfredsheten. -
Generelt så er det viktig med en balanse mellom forventninger og opplevd kvalitet (selve leveransen). Med andre ord, dersom gapet mellom hva foreldrene forventer og hvordan de opplever kvaliteten (negativt gap) blir for stor, så vil det ha negativ betydning for tilfredsheten.
-
NB: I spørsmålsteksten er {XX} benyttet som en plassholder. Da foreldrene svarte på undersøkelsen ble dette feltet byttet ut med navnet på barnehagen (altså
r entity).
Kundeprofil for r entity
# Frametitle ------------------------------------------------------------------- cat("##", "","\n", sep=" ") # Use survey_table to collect the data pd <- latent_scores %>% filter(mainentity %in% c(entity, get_translation(srv, c("study_average", "contrast_average")))) %>% select(-n, -manifest) # Get the vertical justification for geom text --------------------------------- vjust <- pd %>% spread(mainentity, answer) vjust$overlap <- if (ncol(vjust) > 3) rowMeans(vjust[, 2:ncol(vjust)]) else vjust[[ncol(vjust)]] vjust <- ifelse(vjust[[entity]] < vjust[["overlap"]], -1.5, 1.5) # Calculate appropriate range for y-axis --------------------------------------- y_max <- ifelse(max(pd[["answer"]]) < 90, round(max(pd[["answer"]])+10, -1), 100) y_min <- ifelse(min(pd[["answer"]]) > 10, round(min(pd[["answer"]])-10, -1), 0) # Create the profile-plot ------------------------------------------------------ p <- ggplot(data=pd, aes(x=question, y=answer, group=mainentity, colour=mainentity)) p + geom_line(size=1) + geom_point(size=3) + scale_color_manual(values = fixed_colors(palette, as.character(pd$mainentity))) + geom_text(data = filter(pd, mainentity == entity), aes(label=sprintf("%.1f", answer)), size=4, colour="#23373b", vjust=.5, nudge_y=vjust) + ylim(y_min, y_max) + guides(linetype=FALSE) + plot_theme()
# Title and subtitle ----------------------------------------------------------- cat("#", "Kundeprofil per", get_translation(srv, "subentity"), "\n", sep = " ") cat("##", "","\n", sep=" ") # Use survey_table to collect the data pd <- srv %>% filter(mainentity %in% entity, !is.na(subentity)) %>% mutate(subentity = factor(subentity)) %>% group_by(subentity) %>% survey_table(one_of(get_default("latents")), wide = FALSE, contrast = FALSE) %>% mutate(subentity = ifelse(subentity %in% get_translation(srv, "study_average"), "Snitt", as.character(subentity))) %>% mutate(subentity = factor(stri_trans_totitle(subentity), levels = stri_trans_totitle(unique(subentity)))) %>% select(-n, -manifest) # Get the vertical justification for geom text --------------------------------- vjust <- pd %>% spread(subentity, answer) vjust$overlap <- if (ncol(vjust) > 3) rowMeans(vjust[, 2:ncol(vjust)]) else vjust[[ncol(vjust)]] vjust <- ifelse(vjust[["Snitt"]] < vjust[["overlap"]], -1.5, 1.5) # Calculate appropriate range for y-axis --------------------------------------- y_max <- ifelse(max(pd[["answer"]]) < 90, round(max(pd[["answer"]])+10, -1), 100) y_min <- ifelse(min(pd[["answer"]]) > 10, round(min(pd[["answer"]])-10, -1), 0) # Add linetypes pd <- pd %>% mutate(line = ifelse(subentity == "Snitt", "solid", "dashed")) # Create the profile-plot ------------------------------------------------------ p <- ggplot(data=pd, aes(x=question, y=answer, group=subentity, colour=subentity, linetype = line)) p + geom_line(size=1) + geom_point(size=3) + scale_color_manual(values = fixed_colors(setNames(palette, c(entity, "Snitt")), pd$subentity)) + geom_text(data = filter(pd, subentity == "Snitt"), aes(label=sprintf("%.1f", answer)), size=4, colour="#23373b", vjust=.5, nudge_y=vjust) + ylim(y_min, y_max) + guides(linetype=FALSE, color=guide_legend(nrow=2, byrow=TRUE)) + plot_theme()
# Frametitle ------------------------------------------------------------------- cat("# Historikk\n") cat("##", "","\n", sep=" ") csemester <- "fall"; cyear <- 2015 # Use survey_table to collect the data pd <- latent_scores %>% filter(mainentity %in% entity) %>% select(-n, -question) %>% spread(manifest, answer) %>% mutate(year = cyear, semester = csemester) # Add the historical data transl <- setNames(c("spring", "fall"), get_translation(srv, c("spring", "fall"))) pd <- bind_rows(pd, srv$hd %>% filter(mainentity == entity)) %>% arrange(desc(year), semester) %>% mutate(semester = ordered_replace(semester, transl), mainentity = stri_c(semester, year, sep = " ")) # Convert to long format and replace names transl <- setNames(get_default("latents"), get_translation(srv, get_default("latents"))) pd <- pd %>% select(-semester, -year) %>% gather(question, answer, -mainentity) %>% filter(question %in% c("epsi", "loyal")) %>% mutate(question = ordered_replace(as.character(question), transl)) %>% mutate(question = factor(question, names(transl), ordered = TRUE)) %>% mutate(mainentity = factor(mainentity, levels = unique(mainentity), ordered = TRUE)) # Calculate appropriate range for y-axis --------------------------------------- y_max <- ifelse(max(pd[["answer"]]) < 90, round(max(pd[["answer"]])+10, -1), 100) y_min <- ifelse(min(pd[["answer"]]) > 10, round(min(pd[["answer"]])-10, -1), 0) # Create the profile-plot ------------------------------------------------------ p <- ggplot(data=pd, aes(x=question, y=answer, group=mainentity, fill=mainentity)) p + geom_bar(stat="identity", width=0.5, position=position_dodge(width=0.6)) + scale_y_continuous(limits=c(y_min, y_max), oob = rescale_none) + #coord_cartesian(ylim = c(y_min, y_max)) + scale_fill_manual(values = setNames(palette, unique(pd$mainentity))) + geom_text(aes(label=sprintf("%.1f", answer)), size=3, colour="#23373b", position=position_dodge(width=0.6), vjust=-1.1, hjust=.35) + guides(fill = guide_legend(keywidth = .5, keyheight = .5)) + plot_theme() + theme(title = element_text(hjust = -.1))
GAP-analyse
# Frametitle ------------------------------------------------------------------- if (get_translation(srv, "contrast_average") %in% model_scores$mainentity) { cat("##", "Differansen mellom", entity, "og", get_translation(srv, "contrast_average"),"\n", sep=" ") } else { cat("##", "Differansen mellom", entity, "og", get_translation(srv, "study_average"),"\n", sep=" ") } # Gather the data pd <- model_scores %>% filter(mainentity %in% c(entity, get_translation(srv, c("contrast_average", "study_average")))) # Calculate the difference between the entity and the average ------------------ pd <- pd %>% spread(mainentity, answer) %>% arrange(latent) pd$difference <- pd[[4]] - pd[[5]] # Shorten the strings and insert them into the data ---------------------------- text <- as.character(pd$question) text <- ifelse(stri_length(text) >= 90, stri_c(stri_sub(text, to = 90-3), "..."), text) pd$question <- text # Ready the data for plotting -------------------------------------------------- pd <- pd %>% select(manifest, question, difference) %>% mutate("sign" = ifelse(difference > 0, 1, 0)) %>% mutate(sign = factor(sign, levels=unique(sign))) %>% mutate(question = stri_c(manifest, question, sep = " - ")) %>% mutate(question = factor(question, levels=rev(unique(question)))) # Calculate appropriate range for y-axis --------------------------------------- y_min <- 5*floor(min(pd$difference, na.rm=TRUE)/4) y_max <- 5*ceiling(max(pd$difference, na.rm=TRUE)/4) # Create the plot -------------------------------------------------------------- p <- ggplot(data=pd, aes(x=question, y=difference, fill=sign)) p + geom_bar(stat="identity", width=0.5, position="dodge") + coord_flip(ylim = c(y_min, y_max)) + scale_fill_manual(values=setNames(palette, c(1,0))) + geom_hline(yintercept=0, size=.5, colour = "#D0D0D0") + geom_text(data = filter(pd, sign == 1), aes(label=sprintf("%.1f", difference)), size=3, colour="#23373b", vjust=.2, hjust=-.55) + geom_text(data = filter(pd, sign == 0), aes(label=sprintf("%.1f", difference)), size=3, colour="#23373b", vjust=.3, hjust=+1.5) + plot_theme(legend="none") + theme(plot.margin = unit(c(1, 1.5, 0.5, 0.5), "lines"), axis.text.x = element_text(angle = 45, hjust = 1), panel.grid = element_blank())
Resultat per spørsmål
# Frametitle ------------------------------------------------------------------- cat("##", "","\n", sep=" ") # Gather the data pd <- model_scores %>% filter(mainentity %in% c(entity, get_translation(srv, c("contrast_average", "study_average")))) # Calculate the difference between the entity and the average ------------------ if (length(levels(pd$mainentity)) > 1L) { pd <- pd %>% spread(mainentity, answer) %>% arrange(manifest) pd$difference <- pd[[4]] - pd[[5]] } # Replace headers with the translation from config ----------------------------- names(pd) <- ordered_replace(names(pd), setNames(srv$tr$original, srv$tr$replacement)) # Get length of column headers for the table, and truncate manifest text if needed: max_length <- 110 - 2*length(names(pd)) - sum(stri_length(names(pd)[-2])) max_length <- floor(max_length/5)*5 min_length <- stri_length(get_translation(srv, "question")) max_length <- if (max_length < min_length) min_length else max_length # Shorten the strings and insert them into the data ---------------------------- text <- as.character(pd[[get_translation(srv, "question")]]) text <- ifelse(stri_length(text) >= max_length, stri_c(stri_sub(text, to = max_length-3), "..."), text) pd[[get_translation(srv, "question")]] <- text # Divide the data for the two tables ------------------------------------------- first_table <- filter(pd, latent %in% latents[1:3]) %>% select(-latent) %>% xtable(digits=1) second_table <- filter(pd, latent %in% latents[4:length(latents)]) %>% select(-latent) %>% xtable(digits=1) # Capture output and alter to color negative values in red --------------------- first_table <- capture.output(print.xtable(first_table, size="\\tiny", comment=F, include.rownames=F)) second_table <- capture.output(print.xtable(second_table, size="\\tiny", comment=F, include.rownames=F)) first_table <- stri_replace_all(first_table, "$1\\\\textcolor[HTML]{D2232B}{$2}", regex = "(\\s|^)(-\\d?\\d\\.\\d*)") second_table <- stri_replace_all(second_table, "$1\\\\textcolor[HTML]{D2232B}{$2}", regex = "(\\s|^)(-\\d?\\d\\.\\d*)") # Print the first table -------------------------------------------------------- cat(first_table, sep="\n")
# Frametitle ------------------------------------------------------------------- cat("##", "","\n", sep=" ") cat(second_table, sep="\n")
Flowchart
# Frametitle ------------------------------------------------------------------- cat("##", "\n", sep=" ") weights <- srv$inner_weights %>% mutate(origin = stri_trans_tolower(origin)) %>% filter(mainentity == entity, !origin %in% "loyal") %>% select(-image) %>% gather(target, weight, -mainentity, -origin) %>% filter(!(origin == target), !(origin == "image" & target %in% c("value", "loyal")), !(origin == "expect" & target %in% c("value", "epsi", "loyal")), !(origin == "prodq" & target %in% c("expect", "loyal")), !(origin == "servq" & target %in% c("expect", "prodq", "loyal")), !(origin == "value" & target %in% c("expect", "prodq", "servq", "loyal")), !(origin == "epsi" & target != "loyal")) %>% mutate(origin = factor(origin, levels = get_default("latents"), ordered = TRUE)) %>% arrange(origin) %>% mutate(latent = stri_c(stri_c(origin, "_"), target)) %>% select(latent, weight) scores <- latent_scores %>% filter(mainentity == entity) nms <- get_translation(srv, get_default("latents")) p <- flowchart(scores$answer, weights$weight, nms) p + annotate("rect", xmin = .3, xmax = 5.25, ymin = 0, ymax = 10, alpha = .1, fill = palette[1]) + annotate("text", x = 4.93, y = 0.2, label = "Drivere", size = 3, colour = "#23373b", fontface = "bold") # Add footnote ----------------------------------------------------------------- footnote <- stri_c("Pilene i flytdiagrammet viser sammenhengen mellom aspektene vi har målt, og deres effekt på hverandre. Effekten beskrives med et tall mellom 0 og 1, og jo høyere verdi (nærmere 1) dess tettere sammenheng.") cat("\\footnoteextra{", footnote, "}", sep = "")
Effekt på kundetilfredshet
# Frametitle ------------------------------------------------------------------- cat("##", "", "\n", sep=" ") # Gather the data for the table ------------------------------------------------ pd <- srv$outer_weights %>% filter(mainentity == entity) %>% select(latent, manifest, question, epsi_effect) %>% arrange(desc(epsi_effect)) %>% mutate(manifest = stri_trans_totitle(manifest), latent = stri_trans_totitle(latent)) # Replace headers with the translation from config ----------------------------- names(pd) <- ordered_replace(names(pd), setNames(srv$tr$original, srv$tr$replacement)) names(pd)[c(1, 4)] <- c("Aspekt", "Effekt") # Get length of column headers for the table, and truncate manifest text if needed: max_length <- 110 - 2*length(names(pd)) - sum(stri_length(names(pd)[-2])) max_length <- floor(max_length/5)*5 min_length <- stri_length(get_translation(srv, "question")) max_length <- if (max_length < min_length) min_length else max_length # Shorten the strings and insert them into the data ---------------------------- text <- as.character(pd[[get_translation(srv, "question")]]) text <- ifelse(stri_length(text) >= max_length, stri_c(stri_sub(text, to = max_length-3), "..."), text) pd[[get_translation(srv, "question")]] <- text # Divide the data for the two tables ------------------------------------------- first_table <- pd %>% xtable(digits=2) # Capture output and alter to color negative values in red --------------------- first_table <- capture.output(print.xtable(first_table, size="\\tiny", comment=F, include.rownames=F)) # Print the first table -------------------------------------------------------- cat(first_table, sep="\n") # Add footnote ----------------------------------------------------------------- footnote <- "Spørsmålene i tabellen over er sortert etter viktighet. Tabellen leses slik at dersom resultatet på ett enkelt spørsmål øker med 0,5 enhet på en 1-10 skala, så vil kundetilfredsheten øke med det som står i 'effekt' (på en 100 punkts skala)." cat("\\footnoteextra{", footnote, "}", sep = "")
Kontakt og service
# Frametitle ------------------------------------------------------------------- cat("##", get_question(srv, "q7_service"), "\n", sep = " ") # Gather the data for the table ------------------------------------------------ pd <- srv %>% group_by(mainentity) %>% survey_table(q7_service, wide = FALSE) %>% filter(mainentity %in% c(entity, get_translation(srv, c("contrast_average", "study_average")))) %>% mutate(mainentity = factor(mainentity)) # Create the plot -------------------------------------------------------------- p <- ggplot(pd, aes(x=answer, y=proportion, fill=mainentity, group=mainentity, ymin=0, ymax=1)) p + geom_bar(stat="identity", width=0.5, position=position_dodge(width=0.6)) + scale_fill_manual(values=fixed_colors(palette, pd$mainentity), drop=FALSE) + scale_x_discrete(labels = function(x) simple_wrap(x, 15)) + scale_y_continuous(labels=percent) + geom_text(aes(label=sprintf("%.0f%%", proportion*100)), size=3, colour="#23373b", position=position_dodge(width=0.6), vjust=-1.1, hjust=.35) + guides(fill = guide_legend(keywidth = .5, keyheight = .5)) + plot_theme() + theme(title = element_text(hjust = -.1))
cat("##", "Sist du kontaktet {XX}, hvordan opplevde du...", "\n", sep = " ") # Gather the data pd <- srv %>% mutate_each(funs(rescale_score(clean_score(.))), q7sd:q7sf) %>% group_by(mainentity) %>% survey_table(q7sd:q7sf, wide = FALSE) %>% select(-n) %>% filter(mainentity %in% c(entity, get_translation(srv, c("contrast_average", "study_average")))) %>% mutate(mainentity = factor(mainentity)) # Drop unused levels # Calculate appropriate range for y-axis --------------------------------------- y_max <- ifelse(max(pd[["answer"]]) < 90, round(max(pd[["answer"]])+10, -1), 100) y_min <- ifelse(min(pd[["answer"]]) > 10, round(min(pd[["answer"]])-10, -1), 0) # Plot the data p <- ggplot(pd, aes(x=question, y=answer, fill=mainentity, group=mainentity, ymin=0, ymax=100)) p + geom_bar(stat="identity", width=0.5, position=position_dodge(width=0.6)) + scale_fill_manual(values=fixed_colors(palette, pd$mainentity), drop=FALSE) + scale_y_continuous(limits=c(y_min, y_max), oob = rescale_none) + scale_x_discrete(labels = function(x) simple_wrap(x, 25)) + geom_text(aes(label=sprintf("%.1f", answer)), size=3, colour="#23373b", position=position_dodge(width=0.6), vjust=-1.1, hjust=.35) + guides(fill = guide_legend(keywidth = .5, keyheight = .5)) + plot_theme() + theme(panel.margin = unit(2, "lines"))
# Frametitle ------------------------------------------------------------------- cat("# Klager\n") cat("##", "\n", sep = " ") # Create the first plot -------------------------------------------------------- mvar <- get_association(srv, "complaint") pd <- srv %>% group_by(mainentity) %>% survey_table_(dots = mvar, wide = FALSE) %>% filter(mainentity %in% c(entity, get_translation(srv, c("contrast_average", "study_average")))) %>% mutate(mainentity = factor(mainentity)) p1 <- ggplot(pd, aes(x=answer, y=proportion, fill=mainentity, group=mainentity, ymin=0, ymax=1)) p1 <- p1 + geom_bar(stat="identity", width=0.5, position=position_dodge(width=0.6)) + scale_fill_manual(values=fixed_colors(palette, pd$mainentity), drop=FALSE) + scale_x_discrete(labels = function(x) simple_wrap(x, 25)) + scale_y_continuous(labels=percent) + geom_text(aes(label=sprintf("%.0f%%", proportion*100)), size=3, colour="#23373b", position=position_dodge(width=0.6), vjust=-1.1, hjust=.35) + guides(fill = guide_legend(keywidth = .5, keyheight = .5)) + plot_theme() + theme(title = element_text(hjust = 0, size = 10)) + ggtitle(get_question(srv, mvar)) # Create the second plot -------------------------------------------------------- mvar <- get_association(srv, "complaint_handling") call_recode <- lazyeval::interp( ~recode(clean_score(x), as_factor = TRUE, "Lite fornøyd (1-5)" = 1:5L, "Middels (6-8)" = 6:8L, "Svært fornøyd (9-10)" = 9:10L), x = as.name(mvar)) pd <- srv %>% mutate_(.dots = setNames(list(call_recode), mvar)) %>% group_by(mainentity) %>% survey_table_(dots = mvar, wide = FALSE) %>% filter(mainentity %in% c(entity, get_translation(srv, c("contrast_average", "study_average")))) %>% mutate(mainentity = factor(mainentity)) p2 <- ggplot(pd, aes(x=answer, y=proportion, fill=mainentity, group=mainentity, ymin=0, ymax=1.05)) p2 <- p2 + geom_bar(stat="identity", width=0.5, position=position_dodge(width=0.6)) + scale_fill_manual(values=fixed_colors(palette, pd$mainentity), drop=FALSE) + scale_x_discrete(labels = function(x) simple_wrap(x, 25)) + scale_y_continuous(labels=percent) + geom_text(aes(label=sprintf("%.0f%%", proportion*100)), size=3, colour="#23373b", position=position_dodge(width=0.6), vjust=-1.1, hjust=.35) + guides(fill = guide_legend(keywidth = .5, keyheight = .5)) + plot_theme() + theme(title = element_text(hjust = 0, size = 10)) + ggtitle(get_question(srv, mvar)) # Plot both plots with shared legend plot_shared_legend(p1, p2)
Åpne svar
# Frametitle ------------------------------------------------------------------- mvar <- get_association(srv, c("open_complaint", "open_answer")) frametitle <- stri_c("##", get_question(srv, mvar), "(uredigerte svar)", sep = " ") pd <- get_data(srv) %>% select(mainentity, one_of(mvar)) %>% filter(mainentity == entity) %>% gather(var, answers, -mainentity) %>% mutate(answers = clean_text(answers)) %>% mutate(title = ordered_replace(as.character(var), mvar, frametitle)) %>% filter(!is.na(answers)) lines <- stri_wrap(pd$answers, width = 135L, whitespace_only = TRUE, simplify = FALSE) lines <- vapply(lines, length, numeric(1)) pd <- pd %>% mutate(nlines = lines) %>% group_by(var) %>% mutate(tlines = cumsum(nlines)) %>% mutate(page = findInterval(tlines, vec = if (max(tlines) > 23) seq(1, max(tlines), 22) else 1L)) # Inform if no answers were found ---------------------------------------------- for (i in levels(pd$var)) { pdd <- filter(ungroup(pd), var == i) ftt <- pdd$title[1] if (nrow(pd) == 0) { cat(ftt, "Ingen årsaker oppgitt av respondentene.", sep = "\n") # Write to sheet if text is too long (>10 pages) ------------------------------ } else if (ceiling(sum(pd$nlines)/23) > 10 || excel_only) { cat(ftt, "Se vedlagt regneark i Excel format.\n", sep = "\n") pdd %>% mutate(answers = stri_replace(answers, "", regex = "^- ")) %>% select("Svar" = answers) %>% to_sheet(wb, title = stri_replace(ftt, "", regex = "^##"), sheet = i) # Print the results ---------------------------------------------------------- } else { for (ii in unique(pdd$page)) { cat(ftt, pdd$answers[pdd$page == ii], "\n", sep = "\n") } } } # Make sure changes to WB are registered --------------------------------------- wb <- wb
# Write the wb if necessary ---------------------------------------------------- if (length(openxlsx::sheets(wb))) { openxlsx::saveWorkbook(wb, stri_c("../Reports/", entity, " - åpne svar.xlsx"), overwrite = TRUE) }
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Embedding an R snippet on your website
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.