In itsdalmo/reporttoolDT: Work with surveys to generate reports

# Package dependencies ---------------------------------------------------------
library(dplyr)
library(tidyr)
library(stringi)
library(reporttoolDT)

# Check input ------------------------------------------------------------------
if (!exists("srv") || !is.survey(srv)) {
  stop("This template is meant to be used with a Survey.", call. = FALSE)
}

if (!exists("mainentity")) {
  stop("This template requires a 'mainentity' or group passed to generate_report().", call. = FALSE)
}

if (!exists("entity")) {
  stop("Could not find 'entity' variable. Are you using generate_report or report_?", call. = FALSE)
}

# Optional slides --------------------------------------------------------------
if (exists("historic")) {
  if (!mainentity %in% names(historical)) {
    stop("Could not find '", mainentity, "' (group) in 'historic' data.", call. = FALSE)
  }
  historical <- entity %in% historic[[mainentity]]
} else {
  historical <- FALSE
}

flowchart <- !is.null(srv$get_inner_weight(entity))
impacttab <- !is.null(srv$get_outer_weight(entity))

# Get case-insensitive latent names ---------------------------
latents <- names(srv)[stri_trans_tolower(names(srv)) %in% default_latents()]

# Workbook (create and add open answers etc if needed) -------------------------
wb <- excel_workbook()
excel_only <- FALSE

Forord

Gjennomføring

• Målgruppen for denne undersøkelsen er foreldre med barn i r entity.
• 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: xx.
• Det er hentet inn svar på xx 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 str_list(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 str_list(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 str_list(stri_trans_totitle(get_association(srv, "prodq")), "og")) fanger foreldrenes opplevelse av tjeneste- og produkttilbudet.

• r get_translation(srv, "servq") (r str_list(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 str_list(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 str_list(stri_trans_totitle(get_association(srv, "epsi")), "og")).

• r get_translation(srv, "loyal") (r str_list(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).

srv %>% latent_plot(groups = mainentity)

cat("# GAP-analyse\n")
# 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())

cat("# Resultat per spørsmål\n")
cat("## \n")

var <- get_association(srv, default_latents())

out <- srv %>%
  group_by_(mainentity) %>%
  manifest_table(wide = FALSE) %>%
  filter(q1 %in% c(entity, "Average")) %>%
  tidyr::separate(variable, c("variable", "question"), sep = " - ") %>%
  mutate(latent = var) %>%
  select(latent, variable, question, everything()) %>%
  tidyr::spread(q1, value)


t1 <- knitr::kable(filter(out, latent %in% c("image", "expect", "prodq")))
t1 <- knitr::kable(filter(out, latent %in% c("servq", "value", "epsi", "loyal")))

cat(t1, sep="\n")
cat("##", "","\n", sep=" ")
cat(t2, sep="\n")

cat("# Flowchart\n")
cat("## \n")

srv %>% flow_chart(entity)

# Add footnote -----------------------------------------------------------------
footnote <- "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 = "")

cat("# Effekt på kundetilfredshet\n")
cat("## \n")

srv %>% impact_table(entity)

# 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 = "")

# 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/reporttoolDT documentation built on May 18, 2019, 7:11 a.m.