The hardware and bandwidth for this mirror is donated by dogado GmbH, the Webhosting and Full Service-Cloud Provider. Check out our Wordpress Tutorial.
If you wish to report a bug, or if you are interested in having us mirror your free-software or open-source project, please feel free to contact us at mirror[@]dogado.de.
Which aspects of a service drive the global satisfaction of a group of customers? With distributional data the question concerns whole distributions: we want to predict the distribution of the global satisfaction of each group from the distributions of the specific items.
library(DDAWASS)
library(ggplot2)
data(univer, package = "CUB")
univer$Faculty <- factor(sprintf("F%02d", univer$faculty))
univer$Gender <- factor(univer$gender, levels = 0:1, labels = c("M", "W"))
items <- c("informat", "willingn", "officeho", "compete", "global")
M <- data2MatD(univer, unit = c("Faculty", "Gender"), vars = items,
support = 1:7, min.n = 10)
xv <- c("informat", "willingn", "officeho", "compete")Let \(Q_{y_i}\) be the quantile function of the response for group \(i\), and \(\mu_{x_{ij}}\) and \(Q^c_{x_{ij}} = Q_{x_{ij}} - \mu_{x_{ij}}\) the mean and the centred quantile function of the explanatory variable \(j\). The model of Irpino and Verde (2015) is \[Q_{y_i}(t) = \beta_0 + \sum_j \beta_j \mu_{x_{ij}} + \sum_j \gamma_j Q^c_{x_{ij}}(t) + e_i(t), \qquad \gamma_j \ge 0 .\] The \(\beta\) coefficients explain the position (the means) of the response distributions; the \(\gamma\) coefficients explain their variability and shape. The constraint \(\gamma_j \ge 0\) guarantees that the predicted quantile functions are non-decreasing, i.e. that predictions are proper distributions. Parameters minimize the sum of squared Wasserstein distances between observed and predicted distributions; since centred quantile functions are orthogonal to constants, the problem splits into an ordinary least squares regression on the means and a non-negative least squares problem on the centred parts.
pars <- WD.regression.two.components(M, Yvar = "global", Xvars = xv)
round(pars, 3)
#> (AV_Intercept) AV_informat AV_willingn AV_officeho AV_compete
#> -0.217 0.049 0.232 0.156 0.610
#> CEN_informat CEN_willingn CEN_officeho CEN_compete
#> 0.162 0.240 0.056 0.419The AV_ coefficients are those of the regression of the
mean global satisfaction on the means of the items; compete
(competence of the staff) has the largest effect, followed by
willingn and officeho. They coincide with an
ordinary regression on the means:
means <- as.data.frame(get.MatD.stats(M, "mean")$mat)
round(coef(lm(global ~ informat + willingn + officeho + compete, data = means)), 3)
#> (Intercept) informat willingn officeho compete
#> -0.217 0.049 0.232 0.156 0.610The CEN_ coefficients show how the variability of the
judgements on each item is transferred to the global judgement: again
compete has the largest weight, while the dispersion of the
evaluations of the office hours has almost no role.
pred <- WD.regression.two.components.predict(M[, xv], pars)
gof <- WD.regression.GOF(M[, "global"], pred)
gof$RMSE_W
#> [1] 0.3662842
gof$OMEGA
#> [1] 0.9153873
gof$PSEUDOR2$index
#> [1] 0.7588479RMSE_W is the root mean squared Wasserstein error (in
the units of the scale); OMEGA and the pseudo-\(R^2\) measure the share of the variability
of the observed distributions reproduced by the model (Irpino and Verde,
2015).
Observed and predicted distributions can be compared for some groups. Predicted distributions are discrete, but their support values are not restricted to the integers 1-7: they are linear combinations of the quantiles of the explanatory distributions.
sel <- c("F02_M", "F06_W", "F11_M", "F13_W")
obs <- MatD2long(M[sel, "global"]); obs$type <- "observed"
prd <- MatD2long(pred[sel, ]); prd$type <- "predicted"
both <- rbind(obs, prd)
ggplot(both, aes(x, cdf, colour = type)) +
geom_step(direction = "hv", linewidth = 0.8) +
facet_wrap(~ row) +
scale_colour_manual(values = c(observed = "grey20", predicted = "#c62320")) +
labs(x = "global satisfaction", y = "cumulative distribution", colour = NULL) +
theme_minimal()A summary view compares observed and predicted medians and interquartile ranges of all the groups:
q_obs <- sapply(c(0.25, 0.5, 0.75), function(p) get.MatD.stats(M[, "global"], "quantile", p)$mat)
q_prd <- sapply(c(0.25, 0.5, 0.75), function(p) get.MatD.stats(pred, "quantile", p)$mat)
df <- data.frame(group = get.MatD.rownames(M), obs = q_obs[, 2], prd = q_prd[, 2],
obs_lo = q_obs[, 1], obs_hi = q_obs[, 3])
ggplot(df, aes(prd, obs)) +
geom_abline(colour = "grey60") +
geom_errorbar(aes(ymin = obs_lo, ymax = obs_hi), width = 0, colour = "grey60") +
geom_point(size = 2) +
labs(x = "predicted median", y = "observed median (bars: observed IQR)") +
theme_minimal()Standard errors can be obtained by resampling the groups:
set.seed(42)
B <- 200
boot <- t(replicate(B, {
idx <- sample(get.MatD.nrows(M), replace = TRUE)
WD.regression.two.components(M[idx, ], Yvar = "global", Xvars = xv)
}))
ci <- t(apply(boot, 2, quantile, probs = c(0.025, 0.975)))
round(cbind(estimate = pars, ci), 3)
#> estimate 2.5% 97.5%
#> (AV_Intercept) -0.217 -1.129 0.506
#> AV_informat 0.049 -0.143 0.572
#> AV_willingn 0.232 -0.140 0.554
#> AV_officeho 0.156 0.013 0.295
#> AV_compete 0.610 0.083 0.805
#> CEN_informat 0.162 0.081 0.239
#> CEN_willingn 0.240 0.167 0.333
#> CEN_officeho 0.056 0.000 0.130
#> CEN_compete 0.419 0.329 0.503With only 26 groups the intervals are wide. The competence of the
staff (compete) has a clear effect on both the position and
the variability of the global satisfaction; the information received
(informat) and the willingness of the staff
(willingn) matter mostly for the variability
(CEN_ coefficients), while the office hours
(officeho) have a small effect on the means only.
These binaries (installable software) and packages are in development.
They may not be fully stable and should be used with caution. We make no claims about them.
Health stats visible at Monitor.