inst/doc/practical-applications.R

In qDEA: Quantile Data Envelopment Analysis

## ----setup, include = FALSE---------------------------------------------------
knitr::opts_chunk$set(
  collapse = TRUE,
  comment = "#>",
  fig.width = 7,
  fig.height = 5
)
library(qDEA)

## ----hospital-setup-----------------------------------------------------------
# Load hospital data
data(CST22)

# Examine the data
print(CST22)

# 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")
summary(X)
cat("\nOutput summary:\n")
summary(Y)

## ----hospital-dea-------------------------------------------------------------
# Run standard DEA (no outliers allowed)
dea_result <- qDEA(X = X, Y = Y, 
                   orient = "in", 
                   RTS = "VRS", 
                   qout = 0,
                   getproject = TRUE)

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

cat("\nEfficient hospitals:", 
    sum(dea_result$effvals >= 0.99), "out of", nrow(X))

## ----hospital-qdea------------------------------------------------------------
# Run qDEA allowing 10% outliers (≈1 hospital)
qdea_result <- qDEA(X = X, Y = Y,
                    orient = "in",
                    RTS = "VRS",
                    qout = 0.10,
                    getproject = TRUE)

# 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-targets---------------------------------------------------------
# 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)

# Calculate total potential savings
cat("\nTotal potential reductions:\n")
cat("Doctors:", sum(targets$Doctor_Reduction), "\n")
cat("Nurses:", sum(targets$Nurse_Reduction), "\n")

## ----hospital-peers-----------------------------------------------------------
# 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")
hospital_d_peers <- peers[peers$dmu0 == "D", ]
print(hospital_d_peers[order(-hospital_d_peers$z), ])

## ----hospital-report----------------------------------------------------------
# Create executive summary
cat("=" , rep("=", 50), "\n", sep="")
cat("HOSPITAL EFFICIENCY ANALYSIS - EXECUTIVE SUMMARY\n")
cat("=" , rep("=", 50), "\n", sep="")

cat("\nDATA: 12 hospitals\n")
cat("INPUTS: Doctors, Nurses\n")
cat("OUTPUTS: Outpatients, Inpatients\n")
cat("METHOD: qDEA with VRS, 10% outlier allowance\n")

cat("\n--- EFFICIENCY RESULTS ---\n")
cat("Mean efficiency:", round(mean(qdea_result$effvalsq), 3), "\n")
cat("Median efficiency:", round(median(qdea_result$effvalsq), 3), "\n")
cat("Efficient hospitals:", sum(qdea_result$effvalsq >= 0.99), "\n")
cat("Inefficient hospitals:", sum(qdea_result$effvalsq < 0.99), "\n")

cat("\n--- IMPROVEMENT POTENTIAL ---\n")
cat("If all hospitals achieve target efficiency:\n")
cat("  Doctor reduction:", sum(targets$Doctor_Reduction), 
    "(", round(100*sum(targets$Doctor_Reduction)/sum(X[,1]), 1), "%)\n")
cat("  Nurse reduction:", sum(targets$Nurse_Reduction),
    "(", round(100*sum(targets$Nurse_Reduction)/sum(X[,2]), 1), "%)\n")

cat("\n--- TOP PERFORMERS ---\n")
top3 <- head(results_comparison[order(-results_comparison$qDEA_Eff), ], 3)
print(top3[, c("Hospital", "qDEA_Eff")])

cat("\n--- NEEDS IMPROVEMENT ---\n")
bottom3 <- head(results_comparison[order(results_comparison$qDEA_Eff), ], 3)
print(bottom3[, c("Hospital", "qDEA_Eff")])

## ----retail-setup-------------------------------------------------------------
# Load retail data
data(CST21)
print(CST21)

# Prepare data
X <- as.matrix(CST21[, c("EMPLOYEES", "FLOOR_AREA")])
Y <- as.matrix(CST21$SALES)

## ----retail-sensitivity-------------------------------------------------------
# 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)
}

print(sensitivity_results)

# 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")
print(sensitivity_results[order(-sensitivity_results$Range), 
                          c("Store", "Range")])

## ----retail-recommendation----------------------------------------------------
# Use moderate outlier allowance
result_retail <- qDEA(X = X, Y = Y,
                      orient = "out",
                      RTS = "VRS",
                      qout = 0.10,
                      getproject = TRUE)

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

# 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")
table(performance$Category)

## ----outlier-detection--------------------------------------------------------
data(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)

# Run with moderate outlier allowance  
moderate <- qDEA(X = X, Y = Y, orient = "out", RTS = "CRS", qout = 0.15)

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

# Flag potential outliers (large efficiency changes)
outlier_check$Potential_Outlier <- outlier_check$Change > 0.10

cat("\nPotential outliers identified:\n")
print(outlier_check[outlier_check$Potential_Outlier, ])

## ----outlier-impact-----------------------------------------------------------
# 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)

cat("\nMean efficiency:\n")
cat("DEA (no outliers):", round(mean(strict$effvals), 3), "\n")
cat("qDEA (15% outliers):", round(mean(moderate$effvalsq), 3), "\n")

## ----workflow-template, eval=FALSE--------------------------------------------
# # ==========================================
# # 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)
# )

## ----export-csv, eval=FALSE---------------------------------------------------
# # 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)

## ----export-excel, eval=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)

## ----viz-distribution, fig.width=7, fig.height=5------------------------------
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)

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

## ----viz-comparison, fig.width=7, fig.height=6--------------------------------
# Compare DEA and qDEA
dea <- qDEA(X = X, Y = Y, orient = "in", RTS = "VRS", qout = 0)
qdea <- qDEA(X = X, Y = Y, orient = "in", RTS = "VRS", qout = 0.10)

# 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()