In itsdalmo/reporttool: Tools for reporting
# Handling encodings
suppressMessages(require(stringi))
# Reading and manipulating data
suppressMessages(require(data.table))
suppressMessages(require(reshape2))
suppressMessages(require(epsitools))
suppressMessages(require(openxlsx))
suppressMessages(require(magrittr))
suppressMessages(require(lubridate))
# Plotting
suppressMessages(require(ggplot2))
suppressMessages(require(RColorBrewer))
suppressMessages(require(grid))
suppressMessages(require(scales))
# Latex tables and string formatting
suppressMessages(require(xtable))
suppressMessages(require(stringr))
# Hardcoding (na.strings, latents, colors and respondent cutoff for missing values)
missingvalues <- c("NA", " ", "", "#DIV/0!", "#NULL!", "#NAVN?", "#NAME?")
latents <- c("image", "expect", "prodq", "servq", "value", "epsi", "loyal")
ggcolors <- c("#F8766D", "#00BFC4", "#D89000", "#00BF7D", "#9590FF", "#A3A500", "#EA8331")
mv <- .3
# Set relative path, and entity for study
input <- "REPLACE_DATA"
entity <- "REPLACE_ENTITY"
# Read in data
df <- read.xlsx(input, sheet = "data") %>% setDT()
cd <- read.xlsx(input, sheet = "contrast data") %>% setDT()
hd <- read.xlsx(input, sheet = "historic data") %>% setDT()
mm <- read.xlsx(input, sheet = "measurement model") %>% setDT()
cf <- read.xlsx(input, sheet = "config") %>% setDT()
# Set encoding for all character columns to "unknown" (local ANSII)
set_encoding <- function(DT) {
cols <- names(DT)[sapply(DT, is.character)]
DT[, (cols) := lapply(.SD, function(x) {stri_enc_tonative(x)}), .SDcols = cols]
}
df <- set_encoding(df)
cd <- set_encoding(cd)
hd <- set_encoding(hd)
mm <- set_encoding(mm)
cf <- set_encoding(cf)
# Lowercase names for easier referencing
setnames(df, tolower(names(df)))
setnames(cd, tolower(names(cd)))
setnames(hd, tolower(names(hd)))
setnames(mm, tolower(names(mm)))
setnames(cf, tolower(names(cf)))
# Set missing values
set_missing <- function(DT) {
for (j in names(DT))
set(DT, which(DT[[j]] %in% missingvalues), j, NA)
}
set_missing(df)
set_missing(cd)
set_missing(hd)
set_missing(mm)
set_missing(cf)
# Replace names of mainentity and subentity
entitynames <- c(mm[latent == "mainentity", tolower(manifest)], mm[latent == "subentity", tolower(manifest)])
if (any(entitynames %in% names(df))) setnames(df, entitynames, c("mainentity", "subentity")[1:length(entitynames)])
if (any(entitynames %in% names(cd))) setnames(cd, entitynames, c("mainentity", "subentity")[1:length(entitynames)])
if (any(entitynames %in% names(hd))) setnames(hd, entitynames, c("mainentity", "subentity")[1:length(entitynames)])
# Check if weights (w) exist in the data and add a 'natural' weight if not.
df[, w := if ( nrow(.SD) > 0 && !"w" %in% names(.SD) ) 1 else w]
cd[, w := if ( nrow(.SD) > 0 && !"w" %in% names(.SD) ) 1 else w]
hd[, w := if ( nrow(.SD) > 0 && !"w" %in% names(.SD) ) 1 else w]
# Replace {XX} in question text with a shortname for the entity (FIX)
# mm[, text := gsub("\\{XX\\}", "TB", text)]
# Remove common suffixes in entity names (e.g, "barnehage")
if (!is.na(cf$replacement[cf$original == "entity_short"]))
entity_short <- sub(paste0(" ?", cf$replacement[cf$original == "entity_short"], "[^ ]+ ?"), "", entity, ignore.case=TRUE)
# Get the names for averages
ent_sum <- cf$replacement[cf$original == "average"]
ctr_sum <- cf$replacement[cf$original == "contrast_average"]
stu_sum <- cf$replacement[cf$original == "study_average"]
# See if the entity has any historical data and/or contrast data exists (True/False):
historical <- entity %in% hd$mainentity
contrast <- FALSE # FIX
subentities <- "subentity" %in% names(df)
# Check if any statements should be plotted (metric or categorical)
statement_metric <- "statement_metric" %in% tolower(mm$latent)
statement_categorical <- "statement_categorical" %in% tolower(mm$latent)
# Check variables for open answers in complaints
open_noncomplaint <- "open_noncomplaint" %in% tolower(mm$latent)
open_wouldcomplain <- "open_wouldcomplain" %in% tolower(mm$latent)
# Convert date columns and get collection dates
df[, c("start_date", "end_date") := lapply(.SD, mdy_hms), .SDcols=c("start_date", "end_date")]
survey <- df[mainentity == entity, list(start = format(min(start_date, na.rm=TRUE), "%e. %b. %Y"),
end = format(max(start_date, na.rm=TRUE), "%e. %b. %Y"),
time = min(start_date, na.rm=TRUE))] %>%
.[, c("month", "year") := list(format(time, "%m"), format(time, "%Y"))] %>%
.[, "period" := paste(ifelse(month <= 6, cf[tolower(original) == "spring", replacement],
cf[tolower(original) == "fall", replacement]), year)]
# Response information
respondents <- df[mainentity == entity, list(total = .N, valid = .SD[percent_missing <= mv, .N])] %>%
.[, valid_percent := round((valid/total)*100, digits=0)]
# Response per subentity (if specified)
if (subentities)
valid_sub <- df[mainentity == entity & percent_missing <= mv, .(valid = .N), by = subentity] %>%
.[, paste(subentity, valid)]
# Remove incomplete observations
df <- df[percent_missing <= mv]
# Number of latents and model questions
lat_info <- cbind(
mm[grepl(paste0("^[q,b,k][0-9]", collapse="|"), manifest, ignore.case=TRUE), list(total = .N)],
mm[tolower(latent) %in% latents, .N, by=latent] %>%
.[, list(low = min(N), high = max(N), model = sum(N))])
Forord
Gjennomføring
- Datainnsamling gjennomført på web i perioden
r survey$start til r survey$end, og er gjort via Research.net^1.
- Respondentene kan potensielt motta 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 respondenter var
r respondents$total, og av disse var r paste(respondents$valid_percent, "%") av besvarelsene godkjente (et godkjent svar har færre enn r paste0(mv*100, "%") "vet ikke"-svar på modellspørsmål).
r if (subentities) paste0("- ", "Svar per ", tolower(cf$replacement[cf$original == "subentity"]), ": ", paste(valid_sub$valid, collapse = ", "))
- Det er hentet inn svar på
r lat_info$model spørsmål som bygger opp under hovedanalysen. I tillegg til dette så har det vært stilt inntil r lat_info$total-lat_info$model spørsmål som bidrar med ytterligere innsikt i tilfredsheten til respondentene (totalt r lat_info$total).
- Tilsvarende studier gjennomføres ved en rekke andre norske barnehager.
- Alle resultatene som presenteres i denne rapporten er overlevert for bruk ved
r entity.
- Du står selv fritt til å dele resultatene med andre.
- I motsetning til de nasjonale studiene så vil ikke resultatene fra den enkelte barnehage bli publisert i det offentlige rom av EPSI.
- EPSIs nasjonale studie av offentlige tjenester (inkl. private og kommunale barnehager) er en separat studie, og resultatene som formidles via EPSIs hjemmesider^2 kan fritt siteres.
Skala og svar
- Indeksen for kundetilfredshet, det sentrale målet i disse målingene, kan ta en verdi mellom 0 og 100. Jo høyere verdi desto bedre anser de faktiske kundene (de foresatte) at barnehagen oppfyller deres krav og forventninger.
- Spørsmålene svares på en skala fra 1 til 10, hvor 1 betyr ”helt uenig” eller ”veldig misfornøyd” og hvor 10 betyr ”helt enig” eller ”veldig fornøyd”.
-
Resultatene gjøres i etterkant om til en 100-punkts skala.
-
Som en tommelfingerregel så 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 cf[tolower(original) == "image", replacement] (r mm[tolower(latent) == "image", manifest]) er målt for å gi en forståelse av hvordan respondentene oppfatter at r entity vurderes av andre som har kjennskap til barnehagen.
-
r cf[tolower(original) == "expect", replacement] (r mm[tolower(latent) == "expect", manifest]) er et mål på hva kundene forventer å få ut av kundeforholdet.
-
r cf[tolower(original) == "prodq", replacement] (r mm[tolower(latent) == "prodq", manifest]) fanger respondentens opplevelse av tjeneste- og produkttilbudet.
-
r cf[tolower(original) == "servq", replacement] (r mm[tolower(latent) == "servq", manifest]) har fokus på forholdet mellom kunden og de ansatte når det gjelder opplevelsen av service og det mer mellommenneskelige.
-
r cf[tolower(original) == "value", replacement] (r mm[tolower(latent) == "value", manifest]) er utformet for å fange opp forholdet mellom hva som er oppnådd (levert) og prisen / kostnaden for å få dette, sett fra kundens ståsted.
-
r cf[tolower(original) == "epsi", replacement] (KTI) er det sentrale målet i modellen, og reflekterer hvorvidt kundene opplever at deres krav og forventninger blir oppfylt. Resultatet for barnehagen beregnes på bakgrunn av r mm[tolower(latent) == "epsi", length(manifest)] spørsmål (r mm[tolower(latent) == "epsi", manifest]).
-
r cf[tolower(original) == "loyal", replacement] (r mm[tolower(latent) == "loyal", manifest]) måler eksempelvis hvorvidt respondenten ville valgt samme tjeneste eller produkt 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 kundene forventer og hvordan de opplever kvaliteten (negativt gap) blir for stor så vil det ha negativ betydning på tilfredsheten med barnehagen.
Kundeprofil for r entity
# Frametitle
cat("##", "","\n", sep=" ")
pd <- df[mainentity == entity, lapply(.SD, mean), .SDcols=latents, by=mainentity]
# Add the contrast (average of the current or previous study)
if(contrast){
pd <- rbind(pd, cd[, lapply(.SD, weighted.mean, w=cd$w), .SDcols=latents][, mainentity := ctr_sum])
} else {
pd <- rbind(pd, df[, lapply(.SD, mean), .SDcols=latents][, mainentity := stu_sum])
}
# Change to 'long' format for ggplot,
# and replace variable names with proper labels.
pd <- setnames(pd, c("mainentity", cf[original %in% latents, replacement])) %>%
melt(id.vars = c("mainentity"), measure.vars = cf[original %in% latents, replacement], "latent", "score")
# Set levels
pd$mainentity <- factor(pd$mainentity, levels=unique(pd$mainentity))
pd$latent <- factor(pd$latent, levels=unique(pd$latent))
# Get the vertical justification for geom text
vjust <- dcast.data.table(pd, latent ~ mainentity, value.var="score") %>%
.[, overlap := if (ncol(.SD) > 3) rowMeans(.SD[2:ncol(.SD)]) else .SD[[ncol(.SD)]] ] %>%
.[, ifelse(.SD[[entity]] < .SD[["overlap"]], "2", "-1")]
# Calculate appropriate range for y-axis
y_max <- ifelse(pd[, max(score)] < 90, round(pd[, max(score)]+10, -1), 100)
y_min <- ifelse(pd[, min(score)] > 10, round(pd[, min(score)]-10, -1), 0)
# Create the profile-plot
p <- ggplot(data=pd, aes(x=latent, y=score, group=mainentity, colour=mainentity))
p + geom_line(size=1) +
geom_point(size=3) +
scale_color_manual(values = setNames(ggcolors, unique(pd$mainentity))) +
geom_text(data = pd[mainentity == entity],
aes(label=format(round(score, 1))),
size=4, colour="#23373b", vjust=vjust) +
ylim(y_min, y_max) +
plot_theme()
r if(subentities == T) paste("# Profil per", cf[original == "subentity", tolower(replacement)])
# Frametitle
cat("##", "","\n", sep=" ")
# Gather the data for plotting
pd <- rbind(df[mainentity == entity, lapply(.SD, mean), .SDcols = latents, by = mainentity] %>%
.[, mainentity := paste(ent_sum, entity_short)],
df[mainentity == entity, lapply(.SD, mean), .SDcols = latents, by = subentity] %>%
.[, mainentity := subentity])
# Change to 'long' format for ggplot,
# and replace variable names with proper labels.
pd <- setnames(pd, c("mainentity", cf[original %in% latents, replacement])) %>%
melt(id.vars = c("mainentity"), measure.vars = cf[original %in% latents, replacement], "latent", "score")
# Set levels
pd$mainentity <- factor(pd$mainentity, levels=unique(pd$mainentity))
pd$latent <- factor(pd$latent, levels=unique(pd$latent))
# Get the vertical justification for geom text
vjust <- dcast.data.table(pd, latent ~ mainentity, value.var="score") %>%
.[, overlap := if (ncol(.SD) > 3) rowMeans(.SD[2:ncol(.SD)]) else .SD[[ncol(.SD)]] ] %>%
.[, ifelse(.SD[[entity]] < .SD[["overlap"]], "2", "-1")]
# Calculate appropriate range for y-axis
y_max <- ifelse(pd[, max(score)] < 90, round(pd[, max(score)]+10, -1), 100)
y_min <- ifelse(pd[, min(score)] > 10, round(pd[, min(score)]-10, -1), 0)
# Make the average a dashed line
pd[, lines := ifelse(mainentity == paste(ent_sum, entity_short), "solid", "dashed")]
# Create the profile-plot
p <- ggplot(data=pd, aes(x=latent, y=score, group=mainentity, colour=mainentity, linetype=lines))
p + geom_line(size=1) +
geom_point(size=3) +
scale_color_manual(values=setNames(ggcolors, levels(data$mainentity))) +
geom_text(data = pd[mainentity == paste(ent_sum, entity_short)],
aes(label=format(round(score, 1))),
size=4, colour="#23373b", vjust=-1) +
ylim(y_min, y_max) +
guides(linetype=FALSE) +
plot_theme()
r if(historical == T) paste("# Historisk profil for", entity)
# Frametitle
cat("##", "","\n", sep=" ")
# Gather the data for plotting
pd <- rbind(
df[mainentity == entity, c("mainentity", latents), with=FALSE] %>%
.[, lapply(.SD, mean), by = mainentity] %>%
.[, mainentity := survey$period],
hd[mainentity == entity, c("semester", "year", "mainentity", latents), with=FALSE] %>%
.[order(semester, year)] %>%
.[, semester := ifelse(tolower(semester) == "spring", cf[original == "spring", replacement], semester)] %>%
.[, semester := ifelse(tolower(semester) == "fall", cf[original == "fall", replacement], semester)] %>%
.[, mainentity := paste(semester, year)] %>%
.[, lapply(.SD, mean), .SDcols = latents, by = mainentity] %>%
.[, lapply(.SD, function(x) x-3), .SDcols = latents, by = mainentity]) # FIX, just an example
# Change to 'long' format for ggplot,
# and replace variable names with proper labels.
pd <- setnames(pd, c("mainentity", cf[original %in% latents, replacement])) %>%
melt(id.vars = c("mainentity"), measure.vars = cf[original %in% latents, replacement], "latent", "score")
# Set levels
pd$mainentity <- factor(pd$mainentity, levels=unique(pd$mainentity))
pd$latent <- factor(pd$latent, levels=unique(pd$latent))
# Get the vertical justification for geom text
vjust <- dcast.data.table(pd, latent ~ mainentity, value.var="score") %>%
.[, overlap := if (ncol(.SD) > 3) rowMeans(.SD[2:ncol(.SD)]) else .SD[[ncol(.SD)]] ] %>%
.[, ifelse(.SD[[2]] < .SD[["overlap"]], "2", "-1")]
# Calculate appropriate range for y-axis
y_max <- ifelse(pd[, max(score)] < 90, round(pd[, max(score)]+10, -1), 100)
y_min <- ifelse(pd[, min(score)] > 10, round(pd[, min(score)]-10, -1), 0)
# Create the profile-plot
p <- ggplot(data=pd, aes(x=latent, y=score, group=mainentity, colour=mainentity))
p + geom_line(size=1) +
scale_color_manual(values = setNames(ggcolors, levels(pd$mainentity))) +
geom_point(size=3) +
geom_text(data = pd[mainentity == survey$period],
aes(label=format(round(score, 1))),
size=4, colour="#23373b", vjust=vjust) +
ylim(y_min, y_max) +
plot_theme()
SWOT
# Frametitle
if (contrast) {
cat("##", "Differansen mellom", entity, "og", tolower(ctr_sum) ,"\n", sep=" ")
} else {
cat("##", "Differansen mellom", entity, "og", tolower(stu_sum) ,"\n", sep=" ")
}
# Get list of manifest names in correct order.
manifests <- mm[tolower(latent) %in% latents]
manifests <- manifests[order(latent)] %>%
.[, manifest := tolower(manifest)] %>%
.[, text := ifelse(str_length(text) >= 90, paste0(strtrim(text, width=90-3), "..."), text)]
# Get manifest variables
mvar <- paste0(manifests$manifest, "em")
# Gather the data for the table
pd <- df[mainentity == entity, c("mainentity", mvar), with=FALSE] %>%
.[, lapply(.SD, mean, na.rm=T), by = mainentity]
# Add the contrast (average of the current or previous study)
if(contrast){
pd <- rbind(pd, cd[, lapply(.SD, weighted.mean, na.rm=T, w=cd$w), .SDcols=mvar][, mainentity := ctr_sum])
} else {
pd <- rbind(pd, df[, lapply(.SD, mean, na.rm=T), .SDcols=mvar][, mainentity := stu_sum])
}
# Convert to a longer format and convert to proper variable names.
pd <- melt(pd, id.vars = c("mainentity"), measure.vars = mvar, "manifest", "score") %>%
.[, manifest := gsub("em$|EM$", "", manifest)]
# Set keys, merge, clean manifest names and cast the data
setkey(pd, manifest)
setkey(manifests, manifest)
pd <- pd[manifests][, manifest := gsub("^q", "Q", manifest)] %>%
dcast.data.table(manifest + text + latent ~ mainentity, value.var = "score", fill = 0) %>%
.[, difference := if(ctr_sum %in% names(.SD)) .SD[[entity]] - .SD[[ctr_sum]] else .SD[[entity]] - .SD[[stu_sum]]] %>%
.[, difference := ifelse(difference == .SD[[entity]], NA, difference)] %>%
.[, sign := ifelse(difference > 0, 1, 0)] %>%
.[, text := paste(manifest, text, sep = " - ")] %>%
.[, latent := factor(tolower(latent), levels=latents)] %>%
.[order(latent)]
# Ready the data for plotting
pd$text <- factor(pd$text, levels=rev(unique(pd$text)))
pd$sign <- factor(pd$sign, levels=unique(pd$sign))
y_max <- 5*ceiling(pd[, max(difference, na.rm=T)]/4)
y_min <- 5*floor(pd[, min(difference, na.rm=T)]/4)
# Create the profile-plot
p <- ggplot(data=pd, aes(x=text, 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(ggcolors, c(1,0))) +
geom_hline(xintercept=0, size=.5, colour = "#D0D0D0") +
geom_text(data = pd[sign == "1"],
aes(label=format(round(difference, 1))),
size=3, colour="#23373b", vjust=.2, hjust=-.55) +
geom_text(data = pd[sign == "0"],
aes(label=format(round(difference, 1))),
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=" ")
# Get list of manifest names in correct order.
manifests <- mm[tolower(latent) %in% latents]
manifests <- manifests[order(latent)][, manifest := tolower(manifest)]
# Get manifest variables
mvar <- paste0(manifests$manifest, "em")
# Gather the data for the table
pd <- df[mainentity == entity, c("mainentity", mvar), with=FALSE] %>%
.[, lapply(.SD, mean, na.rm=T), by = mainentity] %>%
.[, mainentity := entity_short]
# Add the contrast (average of the current or previous study)
if(contrast){
pd <- rbind(pd, cd[, lapply(.SD, weighted.mean, na.rm=T, w=cd$w), .SDcols=mvar][, mainentity := ctr_sum])
} else {
pd <- rbind(pd, df[, lapply(.SD, mean, na.rm=T), .SDcols=mvar][, mainentity := stu_sum])
}
# Convert to a longer format and convert to proper variable names.
pd <- melt(pd, id.vars = c("mainentity"), measure.vars = mvar, "manifest", "score") %>%
.[, manifest := gsub("em$|EM$", "", manifest)]
# Set keys, merge, clean manifest names and cast the data
setkey(pd, manifest)
setkey(manifests, manifest)
pd <- pd[manifests][, manifest := gsub("^q", "Q", manifest)] %>%
dcast.data.table(manifest + text + latent ~ mainentity, value.var = "score", fill = 0) %>%
.[, difference := if(ctr_sum %in% names(.SD)) .SD[[entity_short]] - .SD[[ctr_sum]] else
.SD[[entity_short]] - .SD[[stu_sum]]] %>%
.[, difference := ifelse(difference == .SD[[entity_short]], NA, difference)] %>%
.[, latent := factor(tolower(latent), levels=latents)] %>%
.[order(latent)]
# Replace columnnames with proper names
setnames(pd, c(entity, cf[original %in% names(pd), original]), c(entity_short, cf[original %in% names(pd), replacement]))
# Get length of column headers for the table, and truncate manifest text if needed:
text_limit <- 110 - 2*length(names(pd)) - sum(str_length(names(pd))) + str_length(cf[original == "text", replacement])
text_limit <- floor(text_limit/5)*5
# Minimum text_limit should be the name of the text column
text_limit <- ifelse(str_length(cf[original == "text", replacement]) > text_limit,
str_length(cf[original == "text", replacement]), text_limit)
# Shorten the strings and insert them into the data
org_text <- pd[[ cf[original == "text", replacement] ]]
org_text <- ifelse(str_length(org_text) >= text_limit, paste0(strtrim(org_text, width=text_limit-3), "..."), org_text)
pd <- pd[, (cf[original == "text", replacement]) := org_text]
# Divide the data for the two tables
first_table <- pd[latent %in% latents[1:3]][, latent := NULL] %>% xtable(digits=1)
second_table <- pd[latent %in% latents[4:length(latents)]][, latent := NULL] %>% 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 <- gsub("(\\s|^)(-\\d?\\d\\.\\d*)", "\\1\\\\textcolor[HTML]{D2232B}{\\2}", first_table)
second_table <- gsub("(\\s|^)(-\\d?\\d\\.\\d*)", "\\1\\\\textcolor[HTML]{D2232B}{\\2}", second_table)
# Print the first table
cat(first_table, sep="\n")
# Frametitle
cat("##", "","\n", sep=" ")
cat(second_table, sep="\n")
Andel klager
# Frametitle
cat("##", mm[latent == "complaint", text], "\n", sep=" ")
# Variable
mvar <- mm[tolower(latent) == "complaint", tolower(manifest)]
# Gather the data for the table
pd <- df[, complaint := .SD[[mvar]]][, c("mainentity", "complaint"), with=FALSE][mainentity == entity]
# Add the contrast (average of the current or previous study)
if (contrast) {
pd <- rbind(pd, cd[, complaint := .SD[[mvar]]][, c("mainentity", "complaint"), with=FALSE][, mainentity := ctr_sum])
} else {
pd <- rbind(pd, df[, complaint := .SD[[mvar]]][, c("mainentity", "complaint"), with=FALSE][, mainentity := stu_sum])
}
# Prepare the data
pd <- pd[, .N, by = c("mainentity", "complaint")] %>%
.[, proportion := prop.table(N), by = c("mainentity")] %>%
dcast(complaint ~ mainentity, value.var="proportion", fill=0) %>%
melt(id.vars="complaint", variable.name = "mainentity", value.name="proportion")
# Create the plot
p <- ggplot(pd, aes(x=complaint, 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=setNames(ggcolors, levels(pd$mainentity))) +
scale_x_discrete(labels = function(x) str_wrap(as.character(x), width = 15)) +
scale_y_continuous(labels=percent) +
geom_text(aes(label=paste0(round(proportion*100, digits=0), "%")),
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))
Klager
# Frametitle
frametitle <- paste("##", mm[latent == "open_complaint", text][1], "(uredigerte svar)")
# Get the complaint variable
mvar <- mm[tolower(latent) == "open_complaint", tolower(manifest)]
# Gather the data
pd <- df[mainentity == entity, c(mvar), with=FALSE] %>%
setnames(mvar, "complaint") %>%
.[!is.na(complaint)] %>%
.[, complaint := gsub("^[!#$%()*,.:;<=>@^_`|~.{}-]|[\\\\]*", "", complaint)] %>%
.[, complaint := paste("-", complaint)] %>%
.[, nchars := str_length(complaint)] %>%
.[, nlines := ceiling(nchars/135)] %>%
.[, tlines := cumsum(nlines)] %>%
.[, page := ifelse(tlines <= 25, 1, ifelse(tlines <= 50 & tlines > 25, 2, 3))]
if (nrow(pd) == 0) {
E0 <- FALSE
E1 <- FALSE
E2 <- FALSE
E3 <- FALSE
E_none <- TRUE
} else if (max(pd$tlines > 75)) {
E0 <- TRUE
E1 <- FALSE
E2 <- FALSE
E3 <- FALSE
E_none <- FALSE
} else {
E0 <- FALSE
E1 <- any(pd$page == 1)
E2 <- any(pd$page == 2)
E3 <- any(pd$page == 3)
E_none <- FALSE
}
# Frame title and content
cat(frametitle, "Se vedlagt regneark i Excel format.", sep="\n")
# Write data
copy(pd)[, complaint := gsub("^- ", "", complaint)][, .(complaint)] %>% setnames("complaint", "Klager") %>%
write.csv2(paste0("Reports/", entity, " - klager", ".csv"), fileEncoding="latin1")
cat(frametitle, pd[page == 1, complaint], sep="\n")
cat(frametitle, pd[page == 2, complaint], sep="\n")
cat(frametitle, pd[page == 3, complaint], sep="\n")
cat(frametitle, "Ingen årsaker oppgitt av respondentene.", sep="\n")
# Frametitle
frametitle <- paste("##", mm[latent == "open_wouldcomplain", text][1], "(uredigerte svar)")
# Get the complaint variable
mvar <- mm[tolower(latent) == "open_wouldcomplain", tolower(manifest)]
# Gather the data
pd <- df[mainentity == entity, c(mvar), with=FALSE] %>%
setnames(mvar, "complaint") %>%
.[!is.na(complaint)] %>%
.[, complaint := gsub("^[!#$%()*,.:;<=>@^_`|~.{}-]|[\\\\]*", "", complaint)] %>%
.[, complaint := paste("-", complaint)] %>%
.[, nchars := str_length(complaint)] %>%
.[, nlines := ceiling(nchars/135)] %>%
.[, tlines := cumsum(nlines)] %>%
.[, page := ifelse(tlines <= 25, 1, ifelse(tlines <= 50 & tlines > 25, 2, 3))]
if (nrow(pd) == 0) {
E0 <- FALSE
E1 <- FALSE
E2 <- FALSE
E3 <- FALSE
E_none <- TRUE
} else if (max(pd$tlines > 75)) {
E0 <- TRUE
E1 <- FALSE
E2 <- FALSE
E3 <- FALSE
E_none <- FALSE
} else {
E0 <- FALSE
E1 <- any(pd$page == 1)
E2 <- any(pd$page == 2)
E3 <- any(pd$page == 3)
E_none <- FALSE
}
# Frame title and content
cat(frametitle, "Se vedlagt regneark i Excel format.", sep="\n")
# Write data
copy(pd)[, complaint := gsub("^- ", "", complaint)][, .(complaint)] %>% setnames("complaint", "Klager") %>%
write.csv2(paste0("Reports/", entity, " - grunn til klage", ".csv"), fileEncoding="latin1")
cat(frametitle, pd[page == 1, complaint], sep="\n")
cat(frametitle, pd[page == 2, complaint], sep="\n")
cat(frametitle, pd[page == 3, complaint], sep="\n")
cat(frametitle, "Ingen årsaker oppgitt av respondentene.", sep="\n")
r if (open_noncomplaint) "# Ikke klaget"
# Frametitle
frametitle <- paste("##", mm[latent == "open_noncomplaint", text][1], "(uredigerte svar)")
# Get the complaint variable
mvar <- mm[tolower(latent) == "open_noncomplaint", tolower(manifest)]
# Gather the data
pd <- df[mainentity == entity, c(mvar), with=FALSE] %>%
setnames(mvar, "complaint") %>%
.[!is.na(complaint)] %>%
.[, complaint := gsub("^[!#$%()*,.:;<=>@^_`|~.{}-]|[\\\\]*", "", complaint)] %>%
.[, complaint := paste("-", complaint)] %>%
.[, nchars := str_length(complaint)] %>%
.[, nlines := ceiling(nchars/135)] %>%
.[, tlines := cumsum(nlines)] %>%
.[, page := ifelse(tlines <= 25, 1, ifelse(tlines <= 50 & tlines > 25, 2, 3))]
if (nrow(pd) == 0) {
E0 <- FALSE
E1 <- FALSE
E2 <- FALSE
E3 <- FALSE
E_none <- TRUE
} else if (max(pd$tlines > 75)) {
E0 <- TRUE
E1 <- FALSE
E2 <- FALSE
E3 <- FALSE
E_none <- FALSE
} else {
E0 <- FALSE
E1 <- any(pd$page == 1)
E2 <- any(pd$page == 2)
E3 <- any(pd$page == 3)
E_none <- FALSE
}
# Frame title and content
cat(frametitle, "Se vedlagt regneark i Excel format.", sep="\n")
# Write data
copy(pd)[, complaint := gsub("^- ", "", complaint)][, .(complaint)] %>% setnames("complaint", "Ikke_klaget") %>%
write.csv2(paste0("Reports/", entity, " - ikke klaget", ".csv"), fileEncoding="latin1")
cat(frametitle, pd[page == 1, complaint], sep="\n")
cat(frametitle, pd[page == 2, complaint], sep="\n")
cat(frametitle, pd[page == 3, complaint], sep="\n")
cat(frametitle, "Ingen årsaker oppgitt av respondentene.", sep="\n")
Åpne svar
# Frametitle
frametitle <- paste("##", mm[latent == "open_answer", text][1], "(uredigerte svar)")
# Get the complaint variable
mvar <- mm[tolower(latent) == "open_answer", tolower(manifest)]
# Gather the data
pd <- df[mainentity == entity, c(mvar), with=FALSE] %>%
setnames(mvar, "openanswer") %>%
.[!is.na(openanswer)] %>%
.[, openanswer := gsub("^[!#$%()*,.:;<=>@^_`|~.{}-]|[\\\\]*", "", openanswer)] %>%
.[, openanswer := paste("-", openanswer)] %>%
.[, nchars := str_length(openanswer)] %>%
.[, nlines := ceiling(nchars/135)] %>%
.[, tlines := cumsum(nlines)] %>%
.[, page := ifelse(tlines <= 25, 1, ifelse(tlines <= 50 & tlines > 25, 2, 3))]
if (nrow(pd) == 0) {
E0 <- FALSE
E1 <- FALSE
E2 <- FALSE
E3 <- FALSE
E_none <- TRUE
} else if (max(pd$tlines > 75)) {
E0 <- TRUE
E1 <- FALSE
E2 <- FALSE
E3 <- FALSE
E_none <- FALSE
} else {
E0 <- FALSE
E1 <- any(pd$page == 1)
E2 <- any(pd$page == 2)
E3 <- any(pd$page == 3)
E_none <- FALSE
}
# Frame title and content
cat(frametitle, "Se vedlagt regneark i Excel format.", sep="\n")
# Write data
copy(pd)[, openanswer := gsub("^- ", "", openanswer)][, .(openanswer)] %>% setnames("openanswer", "Apne svar") %>%
write.csv2(paste0("Reports/", entity, " - åpne svar", ".csv"), fileEncoding="latin1")
cat(frametitle, pd[page == 1, openanswer], sep="\n")
cat(frametitle, pd[page == 2, openanswer], sep="\n")
cat(frametitle, pd[page == 3, openanswer], sep="\n")
cat(frametitle, "Ingen åpne svar fra respondentene.", sep="\n")
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.
# Handling encodings suppressMessages(require(stringi)) # Reading and manipulating data suppressMessages(require(data.table)) suppressMessages(require(reshape2)) suppressMessages(require(epsitools)) suppressMessages(require(openxlsx)) suppressMessages(require(magrittr)) suppressMessages(require(lubridate)) # Plotting suppressMessages(require(ggplot2)) suppressMessages(require(RColorBrewer)) suppressMessages(require(grid)) suppressMessages(require(scales)) # Latex tables and string formatting suppressMessages(require(xtable)) suppressMessages(require(stringr)) # Hardcoding (na.strings, latents, colors and respondent cutoff for missing values) missingvalues <- c("NA", " ", "", "#DIV/0!", "#NULL!", "#NAVN?", "#NAME?") latents <- c("image", "expect", "prodq", "servq", "value", "epsi", "loyal") ggcolors <- c("#F8766D", "#00BFC4", "#D89000", "#00BF7D", "#9590FF", "#A3A500", "#EA8331") mv <- .3 # Set relative path, and entity for study input <- "REPLACE_DATA" entity <- "REPLACE_ENTITY" # Read in data df <- read.xlsx(input, sheet = "data") %>% setDT() cd <- read.xlsx(input, sheet = "contrast data") %>% setDT() hd <- read.xlsx(input, sheet = "historic data") %>% setDT() mm <- read.xlsx(input, sheet = "measurement model") %>% setDT() cf <- read.xlsx(input, sheet = "config") %>% setDT() # Set encoding for all character columns to "unknown" (local ANSII) set_encoding <- function(DT) { cols <- names(DT)[sapply(DT, is.character)] DT[, (cols) := lapply(.SD, function(x) {stri_enc_tonative(x)}), .SDcols = cols] } df <- set_encoding(df) cd <- set_encoding(cd) hd <- set_encoding(hd) mm <- set_encoding(mm) cf <- set_encoding(cf) # Lowercase names for easier referencing setnames(df, tolower(names(df))) setnames(cd, tolower(names(cd))) setnames(hd, tolower(names(hd))) setnames(mm, tolower(names(mm))) setnames(cf, tolower(names(cf))) # Set missing values set_missing <- function(DT) { for (j in names(DT)) set(DT, which(DT[[j]] %in% missingvalues), j, NA) } set_missing(df) set_missing(cd) set_missing(hd) set_missing(mm) set_missing(cf) # Replace names of mainentity and subentity entitynames <- c(mm[latent == "mainentity", tolower(manifest)], mm[latent == "subentity", tolower(manifest)]) if (any(entitynames %in% names(df))) setnames(df, entitynames, c("mainentity", "subentity")[1:length(entitynames)]) if (any(entitynames %in% names(cd))) setnames(cd, entitynames, c("mainentity", "subentity")[1:length(entitynames)]) if (any(entitynames %in% names(hd))) setnames(hd, entitynames, c("mainentity", "subentity")[1:length(entitynames)]) # Check if weights (w) exist in the data and add a 'natural' weight if not. df[, w := if ( nrow(.SD) > 0 && !"w" %in% names(.SD) ) 1 else w] cd[, w := if ( nrow(.SD) > 0 && !"w" %in% names(.SD) ) 1 else w] hd[, w := if ( nrow(.SD) > 0 && !"w" %in% names(.SD) ) 1 else w] # Replace {XX} in question text with a shortname for the entity (FIX) # mm[, text := gsub("\\{XX\\}", "TB", text)] # Remove common suffixes in entity names (e.g, "barnehage") if (!is.na(cf$replacement[cf$original == "entity_short"])) entity_short <- sub(paste0(" ?", cf$replacement[cf$original == "entity_short"], "[^ ]+ ?"), "", entity, ignore.case=TRUE) # Get the names for averages ent_sum <- cf$replacement[cf$original == "average"] ctr_sum <- cf$replacement[cf$original == "contrast_average"] stu_sum <- cf$replacement[cf$original == "study_average"] # See if the entity has any historical data and/or contrast data exists (True/False): historical <- entity %in% hd$mainentity contrast <- FALSE # FIX subentities <- "subentity" %in% names(df) # Check if any statements should be plotted (metric or categorical) statement_metric <- "statement_metric" %in% tolower(mm$latent) statement_categorical <- "statement_categorical" %in% tolower(mm$latent) # Check variables for open answers in complaints open_noncomplaint <- "open_noncomplaint" %in% tolower(mm$latent) open_wouldcomplain <- "open_wouldcomplain" %in% tolower(mm$latent)
# Convert date columns and get collection dates df[, c("start_date", "end_date") := lapply(.SD, mdy_hms), .SDcols=c("start_date", "end_date")] survey <- df[mainentity == entity, list(start = format(min(start_date, na.rm=TRUE), "%e. %b. %Y"), end = format(max(start_date, na.rm=TRUE), "%e. %b. %Y"), time = min(start_date, na.rm=TRUE))] %>% .[, c("month", "year") := list(format(time, "%m"), format(time, "%Y"))] %>% .[, "period" := paste(ifelse(month <= 6, cf[tolower(original) == "spring", replacement], cf[tolower(original) == "fall", replacement]), year)] # Response information respondents <- df[mainentity == entity, list(total = .N, valid = .SD[percent_missing <= mv, .N])] %>% .[, valid_percent := round((valid/total)*100, digits=0)] # Response per subentity (if specified) if (subentities) valid_sub <- df[mainentity == entity & percent_missing <= mv, .(valid = .N), by = subentity] %>% .[, paste(subentity, valid)] # Remove incomplete observations df <- df[percent_missing <= mv] # Number of latents and model questions lat_info <- cbind( mm[grepl(paste0("^[q,b,k][0-9]", collapse="|"), manifest, ignore.case=TRUE), list(total = .N)], mm[tolower(latent) %in% latents, .N, by=latent] %>% .[, list(low = min(N), high = max(N), model = sum(N))])
Forord
Gjennomføring
- Datainnsamling gjennomført på web i perioden
r survey$starttilr survey$end, og er gjort via Research.net^1. - Respondentene kan potensielt motta 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 respondenter var
r respondents$total, og av disse varr paste(respondents$valid_percent, "%")av besvarelsene godkjente (et godkjent svar har færre ennr paste0(mv*100, "%")"vet ikke"-svar på modellspørsmål).r if (subentities) paste0("- ", "Svar per ", tolower(cf$replacement[cf$original == "subentity"]), ": ", paste(valid_sub$valid, collapse = ", ")) - Det er hentet inn svar på
r lat_info$modelspørsmål som bygger opp under hovedanalysen. I tillegg til dette så har det vært stilt inntilr lat_info$total-lat_info$modelspørsmål som bidrar med ytterligere innsikt i tilfredsheten til respondentene (totaltr lat_info$total). - Tilsvarende studier gjennomføres ved en rekke andre norske barnehager.
- Alle resultatene som presenteres i denne rapporten er overlevert for bruk ved
r entity. - Du står selv fritt til å dele resultatene med andre.
- I motsetning til de nasjonale studiene så vil ikke resultatene fra den enkelte barnehage bli publisert i det offentlige rom av EPSI.
- EPSIs nasjonale studie av offentlige tjenester (inkl. private og kommunale barnehager) er en separat studie, og resultatene som formidles via EPSIs hjemmesider^2 kan fritt siteres.
Skala og svar
- Indeksen for kundetilfredshet, det sentrale målet i disse målingene, kan ta en verdi mellom 0 og 100. Jo høyere verdi desto bedre anser de faktiske kundene (de foresatte) at barnehagen oppfyller deres krav og forventninger.
- Spørsmålene svares på en skala fra 1 til 10, hvor 1 betyr ”helt uenig” eller ”veldig misfornøyd” og hvor 10 betyr ”helt enig” eller ”veldig fornøyd”.
-
Resultatene gjøres i etterkant om til en 100-punkts skala.
-
Som en tommelfingerregel så 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 cf[tolower(original) == "image", replacement](r mm[tolower(latent) == "image", manifest]) er målt for å gi en forståelse av hvordan respondentene oppfatter atr entityvurderes av andre som har kjennskap til barnehagen. -
r cf[tolower(original) == "expect", replacement](r mm[tolower(latent) == "expect", manifest]) er et mål på hva kundene forventer å få ut av kundeforholdet. -
r cf[tolower(original) == "prodq", replacement](r mm[tolower(latent) == "prodq", manifest]) fanger respondentens opplevelse av tjeneste- og produkttilbudet. -
r cf[tolower(original) == "servq", replacement](r mm[tolower(latent) == "servq", manifest]) har fokus på forholdet mellom kunden og de ansatte når det gjelder opplevelsen av service og det mer mellommenneskelige. -
r cf[tolower(original) == "value", replacement](r mm[tolower(latent) == "value", manifest]) er utformet for å fange opp forholdet mellom hva som er oppnådd (levert) og prisen / kostnaden for å få dette, sett fra kundens ståsted. -
r cf[tolower(original) == "epsi", replacement](KTI) er det sentrale målet i modellen, og reflekterer hvorvidt kundene opplever at deres krav og forventninger blir oppfylt. Resultatet for barnehagen beregnes på bakgrunn avr mm[tolower(latent) == "epsi", length(manifest)]spørsmål (r mm[tolower(latent) == "epsi", manifest]). -
r cf[tolower(original) == "loyal", replacement](r mm[tolower(latent) == "loyal", manifest]) måler eksempelvis hvorvidt respondenten ville valgt samme tjeneste eller produkt 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 kundene forventer og hvordan de opplever kvaliteten (negativt gap) blir for stor så vil det ha negativ betydning på tilfredsheten med barnehagen.
Kundeprofil for r entity
# Frametitle cat("##", "","\n", sep=" ") pd <- df[mainentity == entity, lapply(.SD, mean), .SDcols=latents, by=mainentity] # Add the contrast (average of the current or previous study) if(contrast){ pd <- rbind(pd, cd[, lapply(.SD, weighted.mean, w=cd$w), .SDcols=latents][, mainentity := ctr_sum]) } else { pd <- rbind(pd, df[, lapply(.SD, mean), .SDcols=latents][, mainentity := stu_sum]) } # Change to 'long' format for ggplot, # and replace variable names with proper labels. pd <- setnames(pd, c("mainentity", cf[original %in% latents, replacement])) %>% melt(id.vars = c("mainentity"), measure.vars = cf[original %in% latents, replacement], "latent", "score") # Set levels pd$mainentity <- factor(pd$mainentity, levels=unique(pd$mainentity)) pd$latent <- factor(pd$latent, levels=unique(pd$latent)) # Get the vertical justification for geom text vjust <- dcast.data.table(pd, latent ~ mainentity, value.var="score") %>% .[, overlap := if (ncol(.SD) > 3) rowMeans(.SD[2:ncol(.SD)]) else .SD[[ncol(.SD)]] ] %>% .[, ifelse(.SD[[entity]] < .SD[["overlap"]], "2", "-1")] # Calculate appropriate range for y-axis y_max <- ifelse(pd[, max(score)] < 90, round(pd[, max(score)]+10, -1), 100) y_min <- ifelse(pd[, min(score)] > 10, round(pd[, min(score)]-10, -1), 0) # Create the profile-plot p <- ggplot(data=pd, aes(x=latent, y=score, group=mainentity, colour=mainentity)) p + geom_line(size=1) + geom_point(size=3) + scale_color_manual(values = setNames(ggcolors, unique(pd$mainentity))) + geom_text(data = pd[mainentity == entity], aes(label=format(round(score, 1))), size=4, colour="#23373b", vjust=vjust) + ylim(y_min, y_max) + plot_theme()
r if(subentities == T) paste("# Profil per", cf[original == "subentity", tolower(replacement)])
# Frametitle cat("##", "","\n", sep=" ") # Gather the data for plotting pd <- rbind(df[mainentity == entity, lapply(.SD, mean), .SDcols = latents, by = mainentity] %>% .[, mainentity := paste(ent_sum, entity_short)], df[mainentity == entity, lapply(.SD, mean), .SDcols = latents, by = subentity] %>% .[, mainentity := subentity]) # Change to 'long' format for ggplot, # and replace variable names with proper labels. pd <- setnames(pd, c("mainentity", cf[original %in% latents, replacement])) %>% melt(id.vars = c("mainentity"), measure.vars = cf[original %in% latents, replacement], "latent", "score") # Set levels pd$mainentity <- factor(pd$mainentity, levels=unique(pd$mainentity)) pd$latent <- factor(pd$latent, levels=unique(pd$latent)) # Get the vertical justification for geom text vjust <- dcast.data.table(pd, latent ~ mainentity, value.var="score") %>% .[, overlap := if (ncol(.SD) > 3) rowMeans(.SD[2:ncol(.SD)]) else .SD[[ncol(.SD)]] ] %>% .[, ifelse(.SD[[entity]] < .SD[["overlap"]], "2", "-1")] # Calculate appropriate range for y-axis y_max <- ifelse(pd[, max(score)] < 90, round(pd[, max(score)]+10, -1), 100) y_min <- ifelse(pd[, min(score)] > 10, round(pd[, min(score)]-10, -1), 0) # Make the average a dashed line pd[, lines := ifelse(mainentity == paste(ent_sum, entity_short), "solid", "dashed")] # Create the profile-plot p <- ggplot(data=pd, aes(x=latent, y=score, group=mainentity, colour=mainentity, linetype=lines)) p + geom_line(size=1) + geom_point(size=3) + scale_color_manual(values=setNames(ggcolors, levels(data$mainentity))) + geom_text(data = pd[mainentity == paste(ent_sum, entity_short)], aes(label=format(round(score, 1))), size=4, colour="#23373b", vjust=-1) + ylim(y_min, y_max) + guides(linetype=FALSE) + plot_theme()
r if(historical == T) paste("# Historisk profil for", entity)
# Frametitle cat("##", "","\n", sep=" ") # Gather the data for plotting pd <- rbind( df[mainentity == entity, c("mainentity", latents), with=FALSE] %>% .[, lapply(.SD, mean), by = mainentity] %>% .[, mainentity := survey$period], hd[mainentity == entity, c("semester", "year", "mainentity", latents), with=FALSE] %>% .[order(semester, year)] %>% .[, semester := ifelse(tolower(semester) == "spring", cf[original == "spring", replacement], semester)] %>% .[, semester := ifelse(tolower(semester) == "fall", cf[original == "fall", replacement], semester)] %>% .[, mainentity := paste(semester, year)] %>% .[, lapply(.SD, mean), .SDcols = latents, by = mainentity] %>% .[, lapply(.SD, function(x) x-3), .SDcols = latents, by = mainentity]) # FIX, just an example # Change to 'long' format for ggplot, # and replace variable names with proper labels. pd <- setnames(pd, c("mainentity", cf[original %in% latents, replacement])) %>% melt(id.vars = c("mainentity"), measure.vars = cf[original %in% latents, replacement], "latent", "score") # Set levels pd$mainentity <- factor(pd$mainentity, levels=unique(pd$mainentity)) pd$latent <- factor(pd$latent, levels=unique(pd$latent)) # Get the vertical justification for geom text vjust <- dcast.data.table(pd, latent ~ mainentity, value.var="score") %>% .[, overlap := if (ncol(.SD) > 3) rowMeans(.SD[2:ncol(.SD)]) else .SD[[ncol(.SD)]] ] %>% .[, ifelse(.SD[[2]] < .SD[["overlap"]], "2", "-1")] # Calculate appropriate range for y-axis y_max <- ifelse(pd[, max(score)] < 90, round(pd[, max(score)]+10, -1), 100) y_min <- ifelse(pd[, min(score)] > 10, round(pd[, min(score)]-10, -1), 0) # Create the profile-plot p <- ggplot(data=pd, aes(x=latent, y=score, group=mainentity, colour=mainentity)) p + geom_line(size=1) + scale_color_manual(values = setNames(ggcolors, levels(pd$mainentity))) + geom_point(size=3) + geom_text(data = pd[mainentity == survey$period], aes(label=format(round(score, 1))), size=4, colour="#23373b", vjust=vjust) + ylim(y_min, y_max) + plot_theme()
SWOT
# Frametitle if (contrast) { cat("##", "Differansen mellom", entity, "og", tolower(ctr_sum) ,"\n", sep=" ") } else { cat("##", "Differansen mellom", entity, "og", tolower(stu_sum) ,"\n", sep=" ") } # Get list of manifest names in correct order. manifests <- mm[tolower(latent) %in% latents] manifests <- manifests[order(latent)] %>% .[, manifest := tolower(manifest)] %>% .[, text := ifelse(str_length(text) >= 90, paste0(strtrim(text, width=90-3), "..."), text)] # Get manifest variables mvar <- paste0(manifests$manifest, "em") # Gather the data for the table pd <- df[mainentity == entity, c("mainentity", mvar), with=FALSE] %>% .[, lapply(.SD, mean, na.rm=T), by = mainentity] # Add the contrast (average of the current or previous study) if(contrast){ pd <- rbind(pd, cd[, lapply(.SD, weighted.mean, na.rm=T, w=cd$w), .SDcols=mvar][, mainentity := ctr_sum]) } else { pd <- rbind(pd, df[, lapply(.SD, mean, na.rm=T), .SDcols=mvar][, mainentity := stu_sum]) } # Convert to a longer format and convert to proper variable names. pd <- melt(pd, id.vars = c("mainentity"), measure.vars = mvar, "manifest", "score") %>% .[, manifest := gsub("em$|EM$", "", manifest)] # Set keys, merge, clean manifest names and cast the data setkey(pd, manifest) setkey(manifests, manifest) pd <- pd[manifests][, manifest := gsub("^q", "Q", manifest)] %>% dcast.data.table(manifest + text + latent ~ mainentity, value.var = "score", fill = 0) %>% .[, difference := if(ctr_sum %in% names(.SD)) .SD[[entity]] - .SD[[ctr_sum]] else .SD[[entity]] - .SD[[stu_sum]]] %>% .[, difference := ifelse(difference == .SD[[entity]], NA, difference)] %>% .[, sign := ifelse(difference > 0, 1, 0)] %>% .[, text := paste(manifest, text, sep = " - ")] %>% .[, latent := factor(tolower(latent), levels=latents)] %>% .[order(latent)] # Ready the data for plotting pd$text <- factor(pd$text, levels=rev(unique(pd$text))) pd$sign <- factor(pd$sign, levels=unique(pd$sign)) y_max <- 5*ceiling(pd[, max(difference, na.rm=T)]/4) y_min <- 5*floor(pd[, min(difference, na.rm=T)]/4) # Create the profile-plot p <- ggplot(data=pd, aes(x=text, 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(ggcolors, c(1,0))) + geom_hline(xintercept=0, size=.5, colour = "#D0D0D0") + geom_text(data = pd[sign == "1"], aes(label=format(round(difference, 1))), size=3, colour="#23373b", vjust=.2, hjust=-.55) + geom_text(data = pd[sign == "0"], aes(label=format(round(difference, 1))), 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=" ") # Get list of manifest names in correct order. manifests <- mm[tolower(latent) %in% latents] manifests <- manifests[order(latent)][, manifest := tolower(manifest)] # Get manifest variables mvar <- paste0(manifests$manifest, "em") # Gather the data for the table pd <- df[mainentity == entity, c("mainentity", mvar), with=FALSE] %>% .[, lapply(.SD, mean, na.rm=T), by = mainentity] %>% .[, mainentity := entity_short] # Add the contrast (average of the current or previous study) if(contrast){ pd <- rbind(pd, cd[, lapply(.SD, weighted.mean, na.rm=T, w=cd$w), .SDcols=mvar][, mainentity := ctr_sum]) } else { pd <- rbind(pd, df[, lapply(.SD, mean, na.rm=T), .SDcols=mvar][, mainentity := stu_sum]) } # Convert to a longer format and convert to proper variable names. pd <- melt(pd, id.vars = c("mainentity"), measure.vars = mvar, "manifest", "score") %>% .[, manifest := gsub("em$|EM$", "", manifest)] # Set keys, merge, clean manifest names and cast the data setkey(pd, manifest) setkey(manifests, manifest) pd <- pd[manifests][, manifest := gsub("^q", "Q", manifest)] %>% dcast.data.table(manifest + text + latent ~ mainentity, value.var = "score", fill = 0) %>% .[, difference := if(ctr_sum %in% names(.SD)) .SD[[entity_short]] - .SD[[ctr_sum]] else .SD[[entity_short]] - .SD[[stu_sum]]] %>% .[, difference := ifelse(difference == .SD[[entity_short]], NA, difference)] %>% .[, latent := factor(tolower(latent), levels=latents)] %>% .[order(latent)] # Replace columnnames with proper names setnames(pd, c(entity, cf[original %in% names(pd), original]), c(entity_short, cf[original %in% names(pd), replacement])) # Get length of column headers for the table, and truncate manifest text if needed: text_limit <- 110 - 2*length(names(pd)) - sum(str_length(names(pd))) + str_length(cf[original == "text", replacement]) text_limit <- floor(text_limit/5)*5 # Minimum text_limit should be the name of the text column text_limit <- ifelse(str_length(cf[original == "text", replacement]) > text_limit, str_length(cf[original == "text", replacement]), text_limit) # Shorten the strings and insert them into the data org_text <- pd[[ cf[original == "text", replacement] ]] org_text <- ifelse(str_length(org_text) >= text_limit, paste0(strtrim(org_text, width=text_limit-3), "..."), org_text) pd <- pd[, (cf[original == "text", replacement]) := org_text] # Divide the data for the two tables first_table <- pd[latent %in% latents[1:3]][, latent := NULL] %>% xtable(digits=1) second_table <- pd[latent %in% latents[4:length(latents)]][, latent := NULL] %>% 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 <- gsub("(\\s|^)(-\\d?\\d\\.\\d*)", "\\1\\\\textcolor[HTML]{D2232B}{\\2}", first_table) second_table <- gsub("(\\s|^)(-\\d?\\d\\.\\d*)", "\\1\\\\textcolor[HTML]{D2232B}{\\2}", second_table) # Print the first table cat(first_table, sep="\n")
# Frametitle cat("##", "","\n", sep=" ") cat(second_table, sep="\n")
Andel klager
# Frametitle cat("##", mm[latent == "complaint", text], "\n", sep=" ") # Variable mvar <- mm[tolower(latent) == "complaint", tolower(manifest)] # Gather the data for the table pd <- df[, complaint := .SD[[mvar]]][, c("mainentity", "complaint"), with=FALSE][mainentity == entity] # Add the contrast (average of the current or previous study) if (contrast) { pd <- rbind(pd, cd[, complaint := .SD[[mvar]]][, c("mainentity", "complaint"), with=FALSE][, mainentity := ctr_sum]) } else { pd <- rbind(pd, df[, complaint := .SD[[mvar]]][, c("mainentity", "complaint"), with=FALSE][, mainentity := stu_sum]) } # Prepare the data pd <- pd[, .N, by = c("mainentity", "complaint")] %>% .[, proportion := prop.table(N), by = c("mainentity")] %>% dcast(complaint ~ mainentity, value.var="proportion", fill=0) %>% melt(id.vars="complaint", variable.name = "mainentity", value.name="proportion") # Create the plot p <- ggplot(pd, aes(x=complaint, 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=setNames(ggcolors, levels(pd$mainentity))) + scale_x_discrete(labels = function(x) str_wrap(as.character(x), width = 15)) + scale_y_continuous(labels=percent) + geom_text(aes(label=paste0(round(proportion*100, digits=0), "%")), 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))
Klager
# Frametitle frametitle <- paste("##", mm[latent == "open_complaint", text][1], "(uredigerte svar)") # Get the complaint variable mvar <- mm[tolower(latent) == "open_complaint", tolower(manifest)] # Gather the data pd <- df[mainentity == entity, c(mvar), with=FALSE] %>% setnames(mvar, "complaint") %>% .[!is.na(complaint)] %>% .[, complaint := gsub("^[!#$%()*,.:;<=>@^_`|~.{}-]|[\\\\]*", "", complaint)] %>% .[, complaint := paste("-", complaint)] %>% .[, nchars := str_length(complaint)] %>% .[, nlines := ceiling(nchars/135)] %>% .[, tlines := cumsum(nlines)] %>% .[, page := ifelse(tlines <= 25, 1, ifelse(tlines <= 50 & tlines > 25, 2, 3))] if (nrow(pd) == 0) { E0 <- FALSE E1 <- FALSE E2 <- FALSE E3 <- FALSE E_none <- TRUE } else if (max(pd$tlines > 75)) { E0 <- TRUE E1 <- FALSE E2 <- FALSE E3 <- FALSE E_none <- FALSE } else { E0 <- FALSE E1 <- any(pd$page == 1) E2 <- any(pd$page == 2) E3 <- any(pd$page == 3) E_none <- FALSE }
# Frame title and content cat(frametitle, "Se vedlagt regneark i Excel format.", sep="\n") # Write data copy(pd)[, complaint := gsub("^- ", "", complaint)][, .(complaint)] %>% setnames("complaint", "Klager") %>% write.csv2(paste0("Reports/", entity, " - klager", ".csv"), fileEncoding="latin1")
cat(frametitle, pd[page == 1, complaint], sep="\n")
cat(frametitle, pd[page == 2, complaint], sep="\n")
cat(frametitle, pd[page == 3, complaint], sep="\n")
cat(frametitle, "Ingen årsaker oppgitt av respondentene.", sep="\n")
# Frametitle frametitle <- paste("##", mm[latent == "open_wouldcomplain", text][1], "(uredigerte svar)") # Get the complaint variable mvar <- mm[tolower(latent) == "open_wouldcomplain", tolower(manifest)] # Gather the data pd <- df[mainentity == entity, c(mvar), with=FALSE] %>% setnames(mvar, "complaint") %>% .[!is.na(complaint)] %>% .[, complaint := gsub("^[!#$%()*,.:;<=>@^_`|~.{}-]|[\\\\]*", "", complaint)] %>% .[, complaint := paste("-", complaint)] %>% .[, nchars := str_length(complaint)] %>% .[, nlines := ceiling(nchars/135)] %>% .[, tlines := cumsum(nlines)] %>% .[, page := ifelse(tlines <= 25, 1, ifelse(tlines <= 50 & tlines > 25, 2, 3))] if (nrow(pd) == 0) { E0 <- FALSE E1 <- FALSE E2 <- FALSE E3 <- FALSE E_none <- TRUE } else if (max(pd$tlines > 75)) { E0 <- TRUE E1 <- FALSE E2 <- FALSE E3 <- FALSE E_none <- FALSE } else { E0 <- FALSE E1 <- any(pd$page == 1) E2 <- any(pd$page == 2) E3 <- any(pd$page == 3) E_none <- FALSE }
# Frame title and content cat(frametitle, "Se vedlagt regneark i Excel format.", sep="\n") # Write data copy(pd)[, complaint := gsub("^- ", "", complaint)][, .(complaint)] %>% setnames("complaint", "Klager") %>% write.csv2(paste0("Reports/", entity, " - grunn til klage", ".csv"), fileEncoding="latin1")
cat(frametitle, pd[page == 1, complaint], sep="\n")
cat(frametitle, pd[page == 2, complaint], sep="\n")
cat(frametitle, pd[page == 3, complaint], sep="\n")
cat(frametitle, "Ingen årsaker oppgitt av respondentene.", sep="\n")
r if (open_noncomplaint) "# Ikke klaget"
# Frametitle frametitle <- paste("##", mm[latent == "open_noncomplaint", text][1], "(uredigerte svar)") # Get the complaint variable mvar <- mm[tolower(latent) == "open_noncomplaint", tolower(manifest)] # Gather the data pd <- df[mainentity == entity, c(mvar), with=FALSE] %>% setnames(mvar, "complaint") %>% .[!is.na(complaint)] %>% .[, complaint := gsub("^[!#$%()*,.:;<=>@^_`|~.{}-]|[\\\\]*", "", complaint)] %>% .[, complaint := paste("-", complaint)] %>% .[, nchars := str_length(complaint)] %>% .[, nlines := ceiling(nchars/135)] %>% .[, tlines := cumsum(nlines)] %>% .[, page := ifelse(tlines <= 25, 1, ifelse(tlines <= 50 & tlines > 25, 2, 3))] if (nrow(pd) == 0) { E0 <- FALSE E1 <- FALSE E2 <- FALSE E3 <- FALSE E_none <- TRUE } else if (max(pd$tlines > 75)) { E0 <- TRUE E1 <- FALSE E2 <- FALSE E3 <- FALSE E_none <- FALSE } else { E0 <- FALSE E1 <- any(pd$page == 1) E2 <- any(pd$page == 2) E3 <- any(pd$page == 3) E_none <- FALSE }
# Frame title and content cat(frametitle, "Se vedlagt regneark i Excel format.", sep="\n") # Write data copy(pd)[, complaint := gsub("^- ", "", complaint)][, .(complaint)] %>% setnames("complaint", "Ikke_klaget") %>% write.csv2(paste0("Reports/", entity, " - ikke klaget", ".csv"), fileEncoding="latin1")
cat(frametitle, pd[page == 1, complaint], sep="\n")
cat(frametitle, pd[page == 2, complaint], sep="\n")
cat(frametitle, pd[page == 3, complaint], sep="\n")
cat(frametitle, "Ingen årsaker oppgitt av respondentene.", sep="\n")
Åpne svar
# Frametitle frametitle <- paste("##", mm[latent == "open_answer", text][1], "(uredigerte svar)") # Get the complaint variable mvar <- mm[tolower(latent) == "open_answer", tolower(manifest)] # Gather the data pd <- df[mainentity == entity, c(mvar), with=FALSE] %>% setnames(mvar, "openanswer") %>% .[!is.na(openanswer)] %>% .[, openanswer := gsub("^[!#$%()*,.:;<=>@^_`|~.{}-]|[\\\\]*", "", openanswer)] %>% .[, openanswer := paste("-", openanswer)] %>% .[, nchars := str_length(openanswer)] %>% .[, nlines := ceiling(nchars/135)] %>% .[, tlines := cumsum(nlines)] %>% .[, page := ifelse(tlines <= 25, 1, ifelse(tlines <= 50 & tlines > 25, 2, 3))] if (nrow(pd) == 0) { E0 <- FALSE E1 <- FALSE E2 <- FALSE E3 <- FALSE E_none <- TRUE } else if (max(pd$tlines > 75)) { E0 <- TRUE E1 <- FALSE E2 <- FALSE E3 <- FALSE E_none <- FALSE } else { E0 <- FALSE E1 <- any(pd$page == 1) E2 <- any(pd$page == 2) E3 <- any(pd$page == 3) E_none <- FALSE }
# Frame title and content cat(frametitle, "Se vedlagt regneark i Excel format.", sep="\n") # Write data copy(pd)[, openanswer := gsub("^- ", "", openanswer)][, .(openanswer)] %>% setnames("openanswer", "Apne svar") %>% write.csv2(paste0("Reports/", entity, " - åpne svar", ".csv"), fileEncoding="latin1")
cat(frametitle, pd[page == 1, openanswer], sep="\n")
cat(frametitle, pd[page == 2, openanswer], sep="\n")
cat(frametitle, pd[page == 3, openanswer], sep="\n")
cat(frametitle, "Ingen åpne svar fra respondentene.", sep="\n")
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.