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.
This vignette demonstrates practical applications of qDEA through real-world examples and workflows. We’ll cover:
A hospital administrator wants to evaluate the efficiency of 12 hospitals using:
The administrator suspects that 1-2 hospitals may have data quality issues or operate under exceptional circumstances.
# Load hospital data
data(CST22)
# Examine the data
print(CST22)
#> HOSPITAL DOCTORS NURSES OUT_PATIENTS IN_PATIENTS
#> 1 A 20 151 100 90
#> 2 B 19 131 150 50
#> 3 C 25 160 160 55
#> 4 D 27 168 180 72
#> 5 E 22 158 94 66
#> 6 F 55 255 230 90
#> 7 G 33 235 220 88
#> 8 H 31 206 152 80
#> 9 I 30 244 190 100
#> 10 J 50 268 250 100
#> 11 K 53 306 260 147
#> 12 L 38 284 250 120
# Prepare inputs and outputs
X <- as.matrix(CST22[, c("DOCTORS", "NURSES")])
Y <- as.matrix(CST22[, c("OUT_PATIENTS", "IN_PATIENTS")])
# Summary statistics
cat("Input summary:\n")
#> Input summary:
summary(X)
#> DOCTORS NURSES
#> Min. :19.00 Min. :131.0
#> 1st Qu.:24.25 1st Qu.:159.5
#> Median :30.50 Median :220.5
#> Mean :33.58 Mean :213.8
#> 3rd Qu.:41.00 3rd Qu.:258.2
#> Max. :55.00 Max. :306.0
cat("\nOutput summary:\n")
#>
#> Output summary:
summary(Y)
#> OUT_PATIENTS IN_PATIENTS
#> Min. : 94.0 Min. : 50.00
#> 1st Qu.:151.5 1st Qu.: 70.50
#> Median :185.0 Median : 89.00
#> Mean :186.3 Mean : 88.17
#> 3rd Qu.:235.0 3rd Qu.:100.00
#> Max. :260.0 Max. :147.00# Run standard DEA (no outliers allowed)
dea_result <- qDEA(X = X, Y = Y,
orient = "in",
RTS = "VRS",
qout = 0,
getproject = TRUE)
#> [1] " on dmu 1 of 12"
#> [1] " on dmu 12 of 12"
# Create results table
results_dea <- data.frame(
Hospital = CST22$HOSPITAL,
Efficiency = round(dea_result$effvals, 3),
Rank = rank(-dea_result$effvals, ties.method = "min")
)
print(results_dea)
#> Hospital Efficiency Rank
#> 1 A 1.000 2
#> 2 B 1.000 2
#> 3 C 0.896 10
#> 4 D 1.000 1
#> 5 E 0.882 11
#> 6 F 0.939 9
#> 7 G 1.000 2
#> 8 H 0.799 12
#> 9 I 0.989 8
#> 10 J 1.000 2
#> 11 K 1.000 7
#> 12 L 1.000 6
cat("\nEfficient hospitals:",
sum(dea_result$effvals >= 0.99), "out of", nrow(X))
#>
#> Efficient hospitals: 7 out of 12# Run qDEA allowing 10% outliers (≈1 hospital)
qdea_result <- qDEA(X = X, Y = Y,
orient = "in",
RTS = "VRS",
qout = 0.10,
getproject = TRUE)
#> [1] " on dmu 1 of 12"
#> [1] " on dmu 12 of 12"
# Compare DEA and qDEA results
results_comparison <- data.frame(
Hospital = CST22$HOSPITAL,
DEA_Eff = round(dea_result$effvals, 3),
qDEA_Eff = round(qdea_result$effvalsq, 3),
Change = round(qdea_result$effvalsq - dea_result$effvals, 3),
DEA_Rank = rank(-dea_result$effvals, ties.method = "min"),
qDEA_Rank = rank(-qdea_result$effvalsq, ties.method = "min")
)
print(results_comparison)
#> Hospital DEA_Eff qDEA_Eff Change DEA_Rank qDEA_Rank
#> 1 A 1.000 1.423 0.423 2 1
#> 2 B 1.000 1.272 0.272 2 2
#> 3 C 0.896 1.000 0.104 10 7
#> 4 D 1.000 1.049 0.049 1 5
#> 5 E 0.882 0.956 0.074 11 10
#> 6 F 0.939 0.984 0.045 9 9
#> 7 G 1.000 1.001 0.001 2 6
#> 8 H 0.799 0.814 0.015 12 11
#> 9 I 0.989 1.000 0.011 8 8
#> 10 J 1.000 1.060 0.060 2 4
#> 11 K 1.000 NA NA 7 12
#> 12 L 1.000 1.263 0.263 6 3# Calculate targets for inefficient hospitals
targets <- data.frame(
Hospital = CST22$HOSPITAL,
Current_Doctors = X[,1],
Target_Doctors = round(qdea_result$PROJ_DATA$X0HATq[,1], 1),
Doctor_Reduction = round(X[,1] - qdea_result$PROJ_DATA$X0HATq[,1], 1),
Current_Nurses = X[,2],
Target_Nurses = round(qdea_result$PROJ_DATA$X0HATq[,2], 1),
Nurse_Reduction = round(X[,2] - qdea_result$PROJ_DATA$X0HATq[,2], 1),
Efficiency = round(qdea_result$effvalsq, 3)
)
# Show only inefficient hospitals
inefficient <- targets[targets$Efficiency < 0.99, ]
print(inefficient)
#> Hospital Current_Doctors Target_Doctors Doctor_Reduction Current_Nurses
#> 5 E 22 21.0 1.0 158
#> 6 F 55 54.1 0.9 255
#> 8 H 31 25.2 5.8 206
#> NA <NA> NA NA NA NA
#> Target_Nurses Nurse_Reduction Efficiency
#> 5 151.0 7.0 0.956
#> 6 250.9 4.1 0.984
#> 8 167.6 38.4 0.814
#> NA NA NA NA
# Calculate total potential savings
cat("\nTotal potential reductions:\n")
#>
#> Total potential reductions:
cat("Doctors:", sum(targets$Doctor_Reduction), "\n")
#> Doctors: NA
cat("Nurses:", sum(targets$Nurse_Reduction), "\n")
#> Nurses: NA# Identify peer hospitals for benchmarking
peers <- qdea_result$PEER_DATA$PEERSq
# Show peers for an inefficient hospital (e.g., Hospital D)
cat("Benchmark hospitals for Hospital D:\n")
#> Benchmark hospitals for Hospital D:
hospital_d_peers <- peers[peers$dmu0 == "D", ]
print(hospital_d_peers[order(-hospital_d_peers$z), ])
#> [1] dmu0 dmuz z
#> <0 rows> (or 0-length row.names)# Create executive summary
cat("=" , rep("=", 50), "\n", sep="")
#> ===================================================
cat("HOSPITAL EFFICIENCY ANALYSIS - EXECUTIVE SUMMARY\n")
#> HOSPITAL EFFICIENCY ANALYSIS - EXECUTIVE SUMMARY
cat("=" , rep("=", 50), "\n", sep="")
#> ===================================================
cat("\nDATA: 12 hospitals\n")
#>
#> DATA: 12 hospitals
cat("INPUTS: Doctors, Nurses\n")
#> INPUTS: Doctors, Nurses
cat("OUTPUTS: Outpatients, Inpatients\n")
#> OUTPUTS: Outpatients, Inpatients
cat("METHOD: qDEA with VRS, 10% outlier allowance\n")
#> METHOD: qDEA with VRS, 10% outlier allowance
cat("\n--- EFFICIENCY RESULTS ---\n")
#>
#> --- EFFICIENCY RESULTS ---
cat("Mean efficiency:", round(mean(qdea_result$effvalsq), 3), "\n")
#> Mean efficiency: NA
cat("Median efficiency:", round(median(qdea_result$effvalsq), 3), "\n")
#> Median efficiency: NA
cat("Efficient hospitals:", sum(qdea_result$effvalsq >= 0.99), "\n")
#> Efficient hospitals: NA
cat("Inefficient hospitals:", sum(qdea_result$effvalsq < 0.99), "\n")
#> Inefficient hospitals: NA
cat("\n--- IMPROVEMENT POTENTIAL ---\n")
#>
#> --- IMPROVEMENT POTENTIAL ---
cat("If all hospitals achieve target efficiency:\n")
#> If all hospitals achieve target efficiency:
cat(" Doctor reduction:", sum(targets$Doctor_Reduction),
"(", round(100*sum(targets$Doctor_Reduction)/sum(X[,1]), 1), "%)\n")
#> Doctor reduction: NA ( NA %)
cat(" Nurse reduction:", sum(targets$Nurse_Reduction),
"(", round(100*sum(targets$Nurse_Reduction)/sum(X[,2]), 1), "%)\n")
#> Nurse reduction: NA ( NA %)
cat("\n--- TOP PERFORMERS ---\n")
#>
#> --- TOP PERFORMERS ---
top3 <- head(results_comparison[order(-results_comparison$qDEA_Eff), ], 3)
print(top3[, c("Hospital", "qDEA_Eff")])
#> Hospital qDEA_Eff
#> 1 A 1.423
#> 2 B 1.272
#> 12 L 1.263
cat("\n--- NEEDS IMPROVEMENT ---\n")
#>
#> --- NEEDS IMPROVEMENT ---
bottom3 <- head(results_comparison[order(results_comparison$qDEA_Eff), ], 3)
print(bottom3[, c("Hospital", "qDEA_Eff")])
#> Hospital qDEA_Eff
#> 8 H 0.814
#> 5 E 0.956
#> 6 F 0.984A retail chain wants to evaluate store performance with potential outliers due to: - Special events or temporary factors - Data entry errors - Unique local market conditions
# Load retail data
data(CST21)
print(CST21)
#> STORE EMPLOYEES FLOOR_AREA SALES
#> 1 A 4.0 3.0 1
#> 2 B 7.0 3.0 1
#> 3 C 8.0 1.0 1
#> 4 D 4.0 2.0 1
#> 5 E 2.0 4.0 1
#> 6 F 5.0 2.0 1
#> 7 G 6.0 4.0 1
#> 8 H 5.5 2.5 1
#> 9 I 6.0 2.5 1
# Prepare data
X <- as.matrix(CST21[, c("EMPLOYEES", "FLOOR_AREA")])
Y <- as.matrix(CST21$SALES)# Test different outlier proportions
qout_values <- c(0, 0.05, 0.10, 0.15, 0.20)
sensitivity_results <- data.frame(
Store = CST21$STORE
)
for (q in qout_values) {
result <- qDEA(X = X, Y = Y, orient = "out", RTS = "CRS", qout = q)
col_name <- paste0("qout_", sprintf("%.2f", q))
sensitivity_results[[col_name]] <- round(result$effvalsq, 3)
}
#> [1] " on dmu 1 of 9"
#> [1] " on dmu 9 of 9"
#> [1] " on dmu 1 of 9"
#> [1] " on dmu 9 of 9"
#> [1] " on dmu 1 of 9"
#> [1] " on dmu 9 of 9"
#> [1] " on dmu 1 of 9"
#> [1] " on dmu 9 of 9"
#> [1] " on dmu 1 of 9"
#> [1] " on dmu 9 of 9"
print(sensitivity_results)
#> Store qout_0.00 qout_0.05 qout_0.10 qout_0.15 qout_0.20
#> 1 A NA 1.167 1.167 1.062 1.062
#> 2 B NA 1.583 1.583 1.438 1.438
#> 3 C NA 1.000 1.000 0.500 0.500
#> 4 D NA 1.000 1.000 0.875 0.875
#> 5 E NA 1.000 1.000 0.500 0.500
#> 6 F NA 1.083 1.083 1.000 1.000
#> 7 G NA 1.667 1.667 1.500 1.500
#> 8 H NA 1.292 1.292 1.156 1.156
#> 9 I NA 1.333 1.333 1.219 1.219
# Calculate how efficiency changes with qout
sensitivity_results$Range <- apply(
sensitivity_results[, -1], 1,
function(x) max(x) - min(x)
)
cat("\nStores most sensitive to outlier allowance:\n")
#>
#> Stores most sensitive to outlier allowance:
print(sensitivity_results[order(-sensitivity_results$Range),
c("Store", "Range")])
#> Store Range
#> 1 A NA
#> 2 B NA
#> 3 C NA
#> 4 D NA
#> 5 E NA
#> 6 F NA
#> 7 G NA
#> 8 H NA
#> 9 I NA# Use moderate outlier allowance
result_retail <- qDEA(X = X, Y = Y,
orient = "out",
RTS = "VRS",
qout = 0.10,
getproject = TRUE)
#> [1] " on dmu 1 of 9"
#> [1] " on dmu 9 of 9"
# Performance report
performance <- data.frame(
Store = CST21$STORE,
Employees = X[,1],
Floor_Area = X[,2],
Actual_Sales = Y[,1],
Target_Sales = round(result_retail$PROJ_DATA$Y0HATq[,1], 0),
Sales_Gap = round(result_retail$PROJ_DATA$Y0HATq[,1] - Y[,1], 0),
Efficiency = round(result_retail$effvalsq, 3)
)
print(performance)
#> Store Employees Floor_Area Actual_Sales Target_Sales Sales_Gap Efficiency
#> 1 A 4.0 3.0 1 1 0 1
#> 2 B 7.0 3.0 1 1 0 1
#> 3 C 8.0 1.0 1 1 0 1
#> 4 D 4.0 2.0 1 1 0 1
#> 5 E 2.0 4.0 1 1 0 1
#> 6 F 5.0 2.0 1 1 0 1
#> 7 G 6.0 4.0 1 1 0 1
#> 8 H 5.5 2.5 1 1 0 1
#> 9 I 6.0 2.5 1 1 0 1
# Classify stores
performance$Category <- ifelse(
performance$Efficiency >= 0.95, "Excellent",
ifelse(performance$Efficiency >= 0.85, "Good",
ifelse(performance$Efficiency >= 0.75, "Needs Improvement",
"Critical"))
)
cat("\nStore Classification:\n")
#>
#> Store Classification:
table(performance$Category)
#>
#> Excellent
#> 9data(CST11)
X <- as.matrix(CST11$EMPLOYEES)
Y <- as.matrix(CST11$SALES_EJOR)
# Run with very restrictive outlier allowance
strict <- qDEA(X = X, Y = Y, orient = "out", RTS = "CRS", qout = 0.01)
#> [1] " on dmu 1 of 8"
#> [1] " on dmu 8 of 8"
# Run with moderate outlier allowance
moderate <- qDEA(X = X, Y = Y, orient = "out", RTS = "CRS", qout = 0.15)
#> [1] " on dmu 1 of 8"
#> [1] " on dmu 8 of 8"
# Stores with big efficiency changes are likely outliers
outlier_check <- data.frame(
Store = CST11$STORE,
Strict = round(strict$effvalsq, 3),
Moderate = round(moderate$effvalsq, 3),
Change = round(moderate$effvalsq - strict$effvalsq, 3)
)
print(outlier_check)
#> Store Strict Moderate Change
#> 1 A 2.667 1.600 -1.067
#> 2 B 1.000 0.600 -0.400
#> 3 C 2.000 1.200 -0.800
#> 4 D 1.778 1.067 -0.711
#> 5 E 1.667 1.000 -0.667
#> 6 F 3.333 2.000 -1.333
#> 7 G 2.667 1.600 -1.067
#> 8 H 2.133 1.280 -0.853
# Flag potential outliers (large efficiency changes)
outlier_check$Potential_Outlier <- outlier_check$Change > 0.10
cat("\nPotential outliers identified:\n")
#>
#> Potential outliers identified:
print(outlier_check[outlier_check$Potential_Outlier, ])
#> [1] Store Strict Moderate Change
#> [5] Potential_Outlier
#> <0 rows> (or 0-length row.names)# Compare DEA vs qDEA to see impact of outlier allowance
impact <- data.frame(
Store = CST11$STORE,
DEA = round(strict$effvals, 3),
qDEA = round(moderate$effvalsq, 3),
Difference = round(moderate$effvalsq - strict$effvals, 3)
)
print(impact)
#> Store DEA qDEA Difference
#> 1 A 2.667 1.600 -1.067
#> 2 B 1.000 0.600 -0.400
#> 3 C 2.000 1.200 -0.800
#> 4 D 1.778 1.067 -0.711
#> 5 E 1.667 1.000 -0.667
#> 6 F 3.333 2.000 -1.333
#> 7 G 2.667 1.600 -1.067
#> 8 H 2.133 1.280 -0.853
cat("\nMean efficiency:\n")
#>
#> Mean efficiency:
cat("DEA (no outliers):", round(mean(strict$effvals), 3), "\n")
#> DEA (no outliers): 2.156
cat("qDEA (15% outliers):", round(mean(moderate$effvalsq), 3), "\n")
#> qDEA (15% outliers): 1.293Here’s a complete workflow you can adapt:
# ==========================================
# COMPLETE qDEA ANALYSIS WORKFLOW
# ==========================================
# 1. Load and examine data
data(CST22) # Replace with your data
X <- as.matrix(CST22[, c("DOCTORS", "NURSES")])
Y <- as.matrix(CST22[, c("OUT_PATIENTS", "IN_PATIENTS")])
# Check data quality
summary(X)
summary(Y)
# Look for: missing values, extreme values, data entry errors
# 2. Run standard DEA baseline
baseline <- qDEA(X = X, Y = Y,
orient = "in", # Choose: in, out, inout
RTS = "VRS", # Choose: CRS, VRS, DRS, IRS
qout = 0)
# 3. Run robust qDEA
robust <- qDEA(X = X, Y = Y,
orient = "in",
RTS = "VRS",
qout = 0.10, # Adjust based on expected outliers
nqiter = 3, # Iterative refinement
getproject = TRUE) # Get targets
# 4. Compare results
comparison <- data.frame(
Unit = rownames(X),
DEA = round(baseline$effvals, 3),
qDEA = round(robust$effvalsq, 3),
Change = round(robust$effvalsq - baseline$effvals, 3)
)
# 5. Identify outliers
potential_outliers <- comparison$Unit[abs(comparison$Change) > 0.10]
# 6. Calculate targets
targets <- data.frame(
Unit = rownames(X),
Efficiency = round(robust$effvalsq, 3),
Current_Input1 = X[,1],
Target_Input1 = round(robust$PROJ_DATA$X0HATq[,1], 2),
Current_Input2 = X[,2],
Target_Input2 = round(robust$PROJ_DATA$X0HATq[,2], 2)
)
# 7. Generate report
# Export to CSV
write.csv(comparison, "efficiency_comparison.csv", row.names = FALSE)
write.csv(targets, "efficiency_targets.csv", row.names = FALSE)
# 8. Optional: Bootstrap for confidence intervals
boot_result <- qDEA(X = X, Y = Y,
orient = "in",
RTS = "VRS",
qout = 0.10,
nboot = 1000,
seedval = 12345)
boot_ci <- data.frame(
Unit = rownames(X),
Efficiency = round(boot_result$effvalsq, 3),
BC_Efficiency = round(boot_result$BOOT_DATA$effvalsq.bc, 3),
Bias = round(boot_result$effvalsq - boot_result$BOOT_DATA$effvalsq.bc, 3)
)✓ Check for missing values
✓ Verify all values are positive
✓ Look for extreme outliers or data entry errors
✓ Ensure comparable units (scale if necessary)
✓ Document data sources and definitions
✓ Choose orientation based on managerial control
✓ Use VRS unless scale efficiency is of interest
✓ Start with qout = 0.10 (10% outliers)
✓ Test sensitivity to qout selection
✓ Efficiency scores are relative, not absolute
✓ Compare units within same analysis only
✓ Consider context (outliers may be legitimate)
✓ Verify targets are achievable
✓ Use peers for benchmarking
✓ Document methodology clearly
✓ Report both DEA and qDEA results
✓ Explain outlier allowance rationale
✓ Provide actionable recommendations
✓ Include sensitivity analysis
✗ Comparing efficiency across different analyses
✗ Using CRS when scale varies significantly
✗ Setting qout too high (> 0.25)
✗ Ignoring data quality issues
✗ Over-interpreting small efficiency differences
# Prepare comprehensive results
results_export <- data.frame(
Unit = CST22$HOSPITAL,
Input1 = X[,1],
Input2 = X[,2],
Output1 = Y[,1],
Output2 = Y[,2],
DEA_Efficiency = round(baseline$effvals, 4),
qDEA_Efficiency = round(robust$effvalsq, 4),
Target_Input1 = round(robust$PROJ_DATA$X0HATq[,1], 2),
Target_Input2 = round(robust$PROJ_DATA$X0HATq[,2], 2)
)
# Export
write.csv(results_export, "qDEA_results.csv", row.names = FALSE)library(openxlsx)
# Create workbook
wb <- createWorkbook()
# Add worksheets
addWorksheet(wb, "Efficiency Scores")
addWorksheet(wb, "Targets")
addWorksheet(wb, "Peers")
# Write data
writeData(wb, "Efficiency Scores", comparison)
writeData(wb, "Targets", targets)
writeData(wb, "Peers", robust$PEER_DATA$PEERSq)
# Save
saveWorkbook(wb, "qDEA_analysis.xlsx", overwrite = TRUE)data(CST22)
X <- as.matrix(CST22[, c("DOCTORS", "NURSES")])
Y <- as.matrix(CST22[, c("OUT_PATIENTS", "IN_PATIENTS")])
result <- qDEA(X = X, Y = Y, orient = "in", RTS = "VRS", qout = 0.10)
#> [1] " on dmu 1 of 12"
#> [1] " on dmu 12 of 12"
# Histogram
hist(result$effvalsq,
breaks = 10,
col = "lightblue",
border = "white",
main = "Distribution of Efficiency Scores",
xlab = "Efficiency",
ylab = "Frequency")
abline(v = mean(result$effvalsq), col = "red", lwd = 2, lty = 2)
legend("topleft",
legend = paste("Mean =", round(mean(result$effvalsq), 3)),
col = "red", lty = 2, lwd = 2)# Compare DEA and qDEA
dea <- qDEA(X = X, Y = Y, orient = "in", RTS = "VRS", qout = 0)
#> [1] " on dmu 1 of 12"
#> [1] " on dmu 12 of 12"
qdea <- qDEA(X = X, Y = Y, orient = "in", RTS = "VRS", qout = 0.10)
#> [1] " on dmu 1 of 12"
#> [1] " on dmu 12 of 12"
# Scatter plot
plot(dea$effvals, qdea$effvalsq,
xlim = c(0.4, 1.2), ylim = c(0.4, 1.2),
xlab = "DEA Efficiency",
ylab = "qDEA Efficiency",
main = "DEA vs qDEA Efficiency Scores",
pch = 19, col = "blue")
abline(0, 1, col = "red", lty = 2) # 45-degree line
text(dea$effvals, qdea$effvalsq,
labels = CST22$HOSPITAL,
pos = 3, cex = 0.8)
grid()This vignette has demonstrated practical applications of qDEA including:
For more details on the underlying methodology, see the main package vignette.
vignette("introduction-to-qDEA")help(package = "qDEA")?qDEAContact: jatwood@montana.edu
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.