Table of content

    Computing Counterfactual Explanations for Linear Optimization: A New Class of Bilevel Models and a Tailored Penalty Alternating Direction Method > NETLIB

    Loading Results

    Instance Statistics

    instances = read.csv("instances.csv", header = FALSE)
    colnames(instances) = c("tag", "instance", "mps", "n_vars", "n_ctrs")
    
    # Remove tag
    instances$tag = NULL
    
    # Clean instance name
    instances$instance = sub("_.*", "", basename(instances$instance))
    instances$mps = basename(instances$mps)
    
    instances = instances[!duplicated(instances$instance), ]
    
    paged_table(instances)

    Results

    time_limit = 1800
    
    data = read.csv("results.csv", header = FALSE)
    stats = c("time", "status", "reason", "objective", "n_outer_iterations", "n_inner_iterations","l1_norm", "l2_norm")
    colnames(data) = c("tag", "instance", "n_vars", "n_ctrs", "desired_space_dim", "n_mutable_coefficients", "n_mutable_costs", "n_mutable_rhs", "method", "update_rule", "update_rule_parameter", "norm", "initial_penalty",  "warm_start", "sol_file", paste0("warm_start_", stats), stats, "solution_ok", "unconstrained_obj", "constrained_obj", "gap")
    
    # Remove tag
    data$tag = data$n_vars = data$n_ctrs = NULL
    
    # Add a one-word solver description
    data$solver = paste0(data$method, " - ", data$update_rule, " ", data$update_rule_parameter, " - ", data$norm, " - init ", data$initial_penalty, " - warm start ", data$warm_start)
    
    # Add 'n_mutable_columns' based on instance name
    data$n_mutable_columns = gsub(".*_(\\d+)$", "\\1", data$instance)
    
    # Clean instance name
    data$full_instance = basename(data$instance)
    
    data$instance = sub("_.*", "", data$full_instance)
    
    data$total_time = ifelse(is.na(data$warm_start_time), 0, data$warm_start_time) + data$time
    
    data$solved = data$status == "Feasible" & data$total_time < time_limit
    
    n_unsolved = sum(!data$solved)
    if (n_unsolved > 0) {
      data[!data$solved,]$total_time = time_limit
    }
    
    data$n_mutable_columns <- as.numeric(as.character(data$n_mutable_columns))  # Convert to numeric

    Merge Instances and Results

    data = merge(data, instances[, c("instance", "n_vars", "n_ctrs")], 
                         by = "instance",
                         all.x = TRUE)

    Performance Analysis

    Summary à la Kurtz

    This is the same table as Table 6 in “Counterfactual Explanations for Linear Optimization”, J. Kurtz (2024).

    We focus on l1-norm with warm-start.

    sub_data = data %>%
      filter(method == "PADM",
             update_rule == "adapt",
             norm == "l1",
             initial_penalty == 5e2,
             warm_start == 1)
    
    var_bounds <- list(c(0, 534), c(534, 2167), c(2167, 22275))
    ctr_bounds <- list(c(0, 351), c(351, 906), c(906, 16675))
    labels <- c("small", "medium", "large")
    
    summary_table = NULL
    
    for (i in seq_along(labels)) {
      for (j in seq_along(labels)) {
        
        sub_summary_table <- sub_data %>%
          filter(
            n_vars >= var_bounds[[i]][1] & n_vars <= var_bounds[[i]][2],
            n_ctrs >= ctr_bounds[[j]][1] & n_ctrs <= ctr_bounds[[j]][2]
          ) %>%
          mutate(
            var_cat = labels[i],
            ctr_cat = labels[j]
          ) %>%
          group_by(var_cat, ctr_cat, n_mutable_columns) %>%
          summarise(
            `# inst.` = n_distinct(instance),  # Count number of instances
            `feasible (in %)` = mean(solved) * 100,  # Percentage of feasible instances
            `# mutable objective param.` = mean(n_mutable_costs, na.rm = TRUE),  # Avg mutable objective parameters
            `# mutable constraint param.` = mean(n_mutable_coefficients, na.rm = TRUE),  # Avg mutable constraint parameters
            .groups = "drop"
          ) %>%
          arrange(var_cat, ctr_cat, n_mutable_columns) %>%  # Sort by var_cat, ctr_cat, and n_mutable_columns
          ungroup()
        
        summary_table = rbind(summary_table, sub_summary_table)    
        
      }
    }
    
    summary_table %>%
      kable("html", align = "c", col.names = c()) %>%
      kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = FALSE, position = "center") %>%
      add_header_above(c("n" = 1, "m" = 1, "# mut. columns" = 1, "# inst." = 1, "feasible (in %)" = 1, 
                         "# mutable objective param." = 1, "# mutable constraint param." = 1)) %>%
      group_rows("small", 1, 6) %>%
      group_rows("medium", 7, 15) %>%
      group_rows("large", 16, 24)
    n
    m
    # mut. columns
    # inst.
    feasible (in %)
    # mutable objective param.
    # mutable constraint param.
    small
    small small 1 28 32.32143 0.3017857 4.376786
    small small 5 28 50.00000 1.5535714 21.175000
    small small 10 28 57.50000 4.0607143 54.962500
    small medium 1 7 30.00000 0.7857143 5.085714
    small medium 5 7 57.14286 4.1071429 31.642857
    small medium 10 7 65.00000 10.8642857 79.628571
    medium
    medium small 1 4 51.25000 0.6125000 5.925000
    medium small 5 4 80.00000 2.5875000 22.575000
    medium small 10 4 90.00000 6.7500000 54.125000
    medium medium 1 22 36.59091 0.4750000 10.420454
    medium medium 5 22 46.59091 2.4568182 19.011364
    medium medium 10 22 51.36364 6.3909091 35.563636
    medium large 1 8 32.50000 0.5312500 2.850000
    medium large 5 8 50.00000 2.0500000 10.675000
    medium large 10 8 59.37500 5.4500000 26.206250
    large
    large small 1 2 25.00000 0.4250000 12.425000
    large small 5 2 47.50000 0.9250000 74.125000
    large small 10 2 50.00000 2.0250000 199.400000
    large medium 1 6 26.66667 0.5333333 2.250000
    large medium 5 6 35.83333 2.7583333 8.975000
    large medium 10 6 44.16667 7.3250000 22.016667
    large large 1 21 45.71429 0.5500000 5.126190
    large large 5 21 53.33333 2.3690476 20.792857
    large large 10 21 55.71429 6.0666667 53.085714

    Solved Instances by Number of Mutable Columns

    bar_data = sub_data %>%
      filter(solved == TRUE) %>%  # Only consider solved instances
      group_by(instance, n_mutable_columns) %>%
      summarise(solved_count = n(), .groups = "drop")  # Count solved instances
    
    # Create bar plot
    ggplot(bar_data, aes(x = instance, y = solved_count, fill = factor(n_mutable_columns))) +
      geom_bar(stat = "identity", position = "dodge") +  # Bar plot with bars side-by-side
      coord_flip() +
      labs(
        title = "Number of Solved Instances by n_mutable_columns for Each Instance",
        x = "Instance",
        y = "Number of Solved Instances",
        fill = "n_mutable_columns"
      ) +
      theme_minimal() +
      theme(axis.text.x = element_text(angle = 90, hjust = 1), legend.position = "top")  # Rotate x-axis labels for better readability

    Computational Times

    for (norm in unique(data$norm)) {
      
      sub_data = data[data$norm == norm, ]
      
      plot = ggplot(sub_data, aes(x = total_time, group = solver, color = solver)) + 
        stat_ecdf(geom = "step") + 
        labs(title = paste0("ECDF of Time for Each Solver using ", norm, " norm"),
             x = "Time",
             y = "ECDF",
             color = "Solver") +
        theme_minimal() +
        theme(legend.position = "bottom") +
        scale_x_continuous(breaks = seq(0, max(sub_data$total_time), by = 60), limits = c(0, time_limit)) +
        scale_y_continuous(breaks = seq(0, 1, by = 0.1))
    
      print(plot)
    }

    for (norm in unique(data$norm)) {
      
      sub_data = data[data$norm == norm,]
      
      sub_data = sub_data %>%
        group_by( sub("^(.+_[0-9]+)_.*", "\\1", full_instance)) %>%
        filter(any(solved == TRUE)) %>%
        ungroup()
    
      plot = ggplot(sub_data, aes(x = total_time, group = solver, color = solver)) + 
        stat_ecdf(geom = "step") + 
        labs(title = paste0("ECDF of Time for Each Solver using ", norm, " norm"),
             x = "Time",
             y = "ECDF",
             color = "Solver") +
        theme_minimal() +
        theme(legend.position = "bottom") +
        scale_x_continuous(breaks = seq(0, max(sub_data$total_time), by = 300), limits = c(0, time_limit)) +
        scale_y_continuous(breaks = seq(0, 1, by = 0.25)) +
        facet_wrap(~ n_mutable_columns, ncol = 3)  # Facet by mutable_columns, 3 columns
      
      ########## SAVING DATA TO FILE FOR TIKZ ##########
      ecdf_data = data.frame(time = sub_data$total_time)
      
      for (n_mutable_columns_val in unique(sub_data$n_mutable_columns)) {
        
        for (warm_start_val in unique(sub_data$warm_start)) {
          
          facet_data = sub_data %>% filter(n_mutable_columns == n_mutable_columns_val & warm_start == warm_start_val)
          
          ecdf_values = ecdf(facet_data$total_time)(sub_data$total_time)
          
          ecdf_data = cbind(ecdf_data, y = ecdf_values)
          colnames(ecdf_data)[ncol(ecdf_data)] = paste0(n_mutable_columns_val, "_w", warm_start_val)
          
        }
      }
      
      ecdf_data <- as.data.frame(ecdf_data)
      ecdf_data <- ecdf_data[order(ecdf_data$time), ]
      ecdf_data = ecdf_data %>% filter(time < 1800)
      
      indices <- seq(1, length(ecdf_data$time), length.out = 100)
      ecdf_data <- ecdf_data[indices, ]
      
      file_name <- paste0("ecdf_", norm, ".csv")
      write.csv(ecdf_data, file_name, row.names = FALSE)
      ###################################################
      
      print(plot)
       
    }

    Scatter Plot of Solved and Unsolved Instances

    sub_data = data[data$update_rule == "adapt" & data$norm == "l1" & data$initial_penalty == 5e2,]
    
    # Create a scatter plot with colors based on the normalized time
    ggplot(sub_data, aes(x = n_vars, y = n_ctrs, color = as.numeric(solved))) +
      geom_point(alpha = .5, size = 1) +  # Transparency and point size
      scale_x_log10() +  # Logarithmic scale for n_vars
      scale_y_log10() +  # Logarithmic scale for n_ctrs
      scale_color_gradient(low = "red", high = "green") +  # Color gradient
      labs(title = "Scatter Plot of (n_vars, n_ctrs) with Log Scale and Transparency",
           x = "Number of Variables (n_vars)",
           y = "Number of Constraints (n_ctrs)",
           color = "Solved") +
      theme_minimal()  # Minimal theme for clean look

    Solution Analysis

    for (norm in unique(data$norm)) {
      sub_data = data[ data$norm == norm,]
      
      sub_data = sub_data %>%
        group_by(full_instance, warm_start) %>%
        filter(all(solved == TRUE)) %>%
        ungroup()
      
      summarize(sub_data)
      
      plot = ggplot(sub_data, aes(x = l1_norm, y = as.factor(warm_start), fill = as.factor(warm_start))) + 
        geom_boxplot() + 
        labs(title = "", #paste0("Boxplot of l1-norm of CE when using the objective function: ", norm),
             x = "",
             y = "") +
        scale_y_discrete(labels = c("No Warm Start", "Warm Start")) + 
        scale_x_log10(breaks = scales::log_breaks(base = 10, n = 8)) +
        theme_minimal() +
        theme(legend.position = "none", axis.text.y = element_text(angle = 90, hjust = .5))
      
      print(plot)
      
      #tikz(file = paste0("boxplot_", norm, ".tex"), width = 4, height = 3)
      print(plot)
      #dev.off()
    }
    ## Warning in scale_x_log10(breaks = scales::log_breaks(base = 10, n = 8)): log-10
    ## transformation introduced infinite values.
    ## Warning: Removed 426 rows containing non-finite outside the scale range
    ## (`stat_boxplot()`).

    ## Warning in scale_x_log10(breaks = scales::log_breaks(base = 10, n = 8)): log-10 transformation introduced infinite values.
    ## Removed 426 rows containing non-finite outside the scale range
    ## (`stat_boxplot()`).

    ## Warning in scale_x_log10(breaks = scales::log_breaks(base = 10, n = 8)): log-10
    ## transformation introduced infinite values.
    ## Warning: Removed 2052 rows containing non-finite outside the scale range
    ## (`stat_boxplot()`).

    ## Warning in scale_x_log10(breaks = scales::log_breaks(base = 10, n = 8)): log-10 transformation introduced infinite values.
    ## Removed 2052 rows containing non-finite outside the scale range
    ## (`stat_boxplot()`).

    ## Warning in scale_x_log10(breaks = scales::log_breaks(base = 10, n = 8)): log-10
    ## transformation introduced infinite values.
    ## Warning: Removed 1268 rows containing non-finite outside the scale range
    ## (`stat_boxplot()`).

    ## Warning in scale_x_log10(breaks = scales::log_breaks(base = 10, n = 8)): log-10 transformation introduced infinite values.
    ## Removed 1268 rows containing non-finite outside the scale range
    ## (`stat_boxplot()`).

    ## Warning in scale_x_log10(breaks = scales::log_breaks(base = 10, n = 8)): log-10
    ## transformation introduced infinite values.
    ## Warning: Removed 2097 rows containing non-finite outside the scale range
    ## (`stat_boxplot()`).

    ## Warning in scale_x_log10(breaks = scales::log_breaks(base = 10, n = 8)): log-10 transformation introduced infinite values.
    ## Removed 2097 rows containing non-finite outside the scale range
    ## (`stat_boxplot()`).

    ## Warning in scale_x_log10(breaks = scales::log_breaks(base = 10, n = 8)): log-10
    ## transformation introduced infinite values.
    ## Warning: Removed 2111 rows containing non-finite outside the scale range
    ## (`stat_boxplot()`).

    ## Warning in scale_x_log10(breaks = scales::log_breaks(base = 10, n = 8)): log-10 transformation introduced infinite values.
    ## Removed 2111 rows containing non-finite outside the scale range
    ## (`stat_boxplot()`).


    This document is automatically generated after every git push action on the public repository hlefebvr/hlefebvr.github.io using rmarkdown and Github Actions. This ensures the reproducibility of our data manipulation. The last compilation was performed on the 15/01/25 12:50:14.