Merge branch 'main' of https://github.com/pat-alt/AlgorithmicRecourseDynamics.jl

Author: pat-alt

dev/notebooks/mitigation_strategies.qmd

@@ -194,28 +194,41 @@ transform!(df_plot, :name => (X -> [x=="mmd_grid" ? "MMD (model)" : x for x in X
 transform!(df_plot, :name => (X -> [x=="model_performance" ? "Performance" : x for x in X]) => :name)
 transform!(df_plot, :generator => (X -> [x=="Generic" ? "Generic (γ=0.5)" : x for x in X]) => :generator)
 transform!(df_plot, :generator => (X -> [x=="Generic_conservative" ? "Generic (γ=0.9)" : x for x in X]) => :generator)
+transform!(df_plot, :model => (X -> [x=="FluxEnsemble" ? "Deep Ensemble" : x for x in X]) => :model)
+transform!(df_plot, :model => (X -> [x=="FluxModel" ? "MLP" : x for x in X]) => :model)
+transform!(df_plot, :model => (X -> [x=="LogisticRegression" ? "Linear" : x for x in X]) => :model)
 
 ncol = length(unique(df_plot.model))
 nrow = length(unique(df_plot.name))
 
 using RCall
-scale_ = 2.2
+scale_ = 2.0
 R"""
+library(data.table)
+df_plot <- data.table($df_plot)
+model_order <- c("Linear", "MLP", "Deep Ensemble")
+df_plot[,model:=factor(model, levels=model_order)]
 library(ggplot2)
 plt <- ggplot($df_plot) +
     geom_bar(aes(x=n, y=mean, fill=generator), stat="identity", alpha=0.5, position="dodge") +
     geom_pointrange( aes(x=n, y=mean, ymin=ymin, ymax=ymax, colour=generator), alpha=0.9, position=position_dodge(width=0.9), size=0.5) +
-    facet_wrap(name ~ model, scale="free_y", ncol=$ncol) +
+    facet_grid(
+        rows = vars(name),
+        cols =  vars(model), 
+        scales = "free_y"
+    ) +
     labs(y = "Value") + 
     scale_fill_discrete(name="Generator:") +
     scale_colour_discrete(name="Generator:") +
     theme(
         axis.title.x=element_blank(),
         axis.text.x=element_blank(),
-        axis.ticks.x=element_blank()
-    )
+        axis.ticks.x=element_blank(),
+        legend.position="bottom"
+    ) +
+    guides(fill=guide_legend(ncol=3))
 temp_path <- file.path(tempdir(), "plot.png")
-ggsave(temp_path,width=$ncol * $scale_,height=$nrow * $scale_ * 0.75) 
+ggsave(temp_path,width=$ncol * $scale_,height=$nrow * $scale_ * 0.8) 
 """
 
 img = Images.load(rcopy(R"temp_path"))
@@ -288,28 +301,41 @@ transform!(df_plot, :name => (X -> [x=="mmd_grid" ? "MMD (model)" : x for x in X
 transform!(df_plot, :name => (X -> [x=="model_performance" ? "Performance" : x for x in X]) => :name)
 transform!(df_plot, :generator => (X -> [x=="Latent" ? "Latent (γ=0.5)" : x for x in X]) => :generator)
 transform!(df_plot, :generator => (X -> [x=="Latent_conservative" ? "Latent (γ=0.9)" : x for x in X]) => :generator)
+transform!(df_plot, :model => (X -> [x=="FluxEnsemble" ? "Deep Ensemble" : x for x in X]) => :model)
+transform!(df_plot, :model => (X -> [x=="FluxModel" ? "MLP" : x for x in X]) => :model)
+transform!(df_plot, :model => (X -> [x=="LogisticRegression" ? "Linear" : x for x in X]) => :model)
 
 ncol = length(unique(df_plot.model))
 nrow = length(unique(df_plot.name))
 
 using RCall
-scale_ = 2.2
+scale_ = 1.9
 R"""
+library(data.table)
+df_plot <- data.table($df_plot)
+model_order <- c("Linear", "MLP", "Deep Ensemble")
+df_plot[,model:=factor(model, levels=model_order)]
 library(ggplot2)
 plt <- ggplot($df_plot) +
     geom_bar(aes(x=n, y=mean, fill=generator), stat="identity", alpha=0.5, position="dodge") +
     geom_pointrange( aes(x=n, y=mean, ymin=ymin, ymax=ymax, colour=generator), alpha=0.9, position=position_dodge(width=0.9), size=0.5) +
-    facet_wrap(name ~ model, scale="free_y", ncol=$ncol) +
+    facet_grid(
+        rows = vars(name),
+        cols =  vars(model), 
+        scales = "free_y"
+    ) +
     labs(y = "Value") + 
     scale_fill_discrete(name="Generator:") +
     scale_colour_discrete(name="Generator:") +
     theme(
         axis.title.x=element_blank(),
         axis.text.x=element_blank(),
-        axis.ticks.x=element_blank()
-    )
+        axis.ticks.x=element_blank(),
+        legend.position="bottom"
+    ) +
+    guides(fill=guide_legend(ncol=4))
 temp_path <- file.path(tempdir(), "plot.png")
-ggsave(temp_path,width=$ncol * $scale_,height=$nrow * $scale_ * 0.75) 
+ggsave(temp_path,width=$ncol * $scale_,height=$nrow * $scale_ * 0.8) 
 """
 
 img = Images.load(rcopy(R"temp_path"))
@@ -329,7 +355,7 @@ generators = Dict(
 ```
 
 ```{julia}
-max_obs = 1000
+max_obs = 2500
 data_sets = AlgorithmicRecourseDynamics.Data.load_real_world(max_obs)
 ```
 
@@ -358,6 +384,7 @@ n_rounds = 50
 evaluate_every = Int(round(n_rounds/n_evals))
 n_folds = 5
 n_bootstrap = 1
+n_samples = 10000
 T = 250
 using Serialization
 results = run_experiments(
@@ -391,68 +418,62 @@ for (data_name, res) in results
 end
 ```
 
-### Latent Space Search
-
-```{julia}
-generators = Dict(
-    :REVISE=>GenericGenerator(decision_threshold=0.5),
-    :REVISE_conservative=>GenericGenerator(decision_threshold=0.9),
-    :Gravitational=>GravitationalGenerator(),
-    :ClapROAR=>ClapROARGenerator()
-)
-```
-
-
-```{julia}
-generative_model_params = (epochs=250, latent_dim=8)
-experiments = set_up_experiments(
-    data_sets,models,generators; 
-    pre_train_models=100, model_params=model_params, 
-    data_loader=data_loader
-)
-```
+### Chart in paper
 
 ```{julia}
-n_evals = 5
-n_rounds = 50
-evaluate_every = Int(round(n_rounds/n_evals))
-n_folds = 5
-n_bootstrap = 1
-T = 200
-using Serialization
-results = run_experiments(
-    experiments;
-    save_path=output_path,
-    save_name_suffix="latent",
-    evaluate_every=evaluate_every,
-    n_rounds=n_rounds, 
-    n_folds=n_folds, 
-    n_bootstrap=n_bootstrap, 
-    T=T,
-    latent_space=true,
-    generative_model_params=generative_model_params
-)
-Serialization.serialize(joinpath(output_path,"results_latent.jls"),results)
-```
+using DataFrames, Statistics
+model_ = :FluxEnsemble
+df = DataFrame() 
+for (key, val) in results
+    df_ = deepcopy(val.output)
+    df_.dataset .= key
+    df = vcat(df,df_)
+end
+df = df[df.n .== maximum(df.n),:]
+df = df[df.model .== model_,:]
+filter!(:value => x -> !any(f -> f(x), (ismissing, isnothing, isnan)), df)
+gdf = groupby(df, [:generator, :dataset, :n, :name, :scope])
+df_plot = combine(gdf, :value => (x -> [(mean(x),mean(x)+std(x),mean(x)-std(x))]) => [:mean, :ymax, :ymin])
+df_plot = df_plot[[name in [:mmd, :model_performance] for name in df_plot.name],:]
+df_plot = df_plot[.!(df_plot.name.==:mmd .&& df_plot.scope.!=:model),:]
+df_plot = mapcols(x -> typeof(x) == Vector{Symbol} ? string.(x) : x, df_plot)
+transform!(df_plot, :dataset => (X -> [x=="cal_housing" ? "California Housing" : x for x in X]) => :dataset)
+transform!(df_plot, :dataset => (X -> [x=="credit_default" ? "Credit Default" : x for x in X]) => :dataset)
+transform!(df_plot, :dataset => (X -> [x=="gmsc" ? "GMSC" : x for x in X]) => :dataset)
+transform!(df_plot, :name => (X -> [x=="mmd" ? "MMD (model)" : x for x in X]) => :name)
+transform!(df_plot, :name => (X -> [x=="model_performance" ? "Performance" : x for x in X]) => :name)
+transform!(df_plot, :generator => (X -> [x=="Generic" ? "Generic (γ=0.5)" : x for x in X]) => :generator)
+transform!(df_plot, :generator => (X -> [x=="Generic_conservative" ? "Generic (γ=0.9)" : x for x in X]) => :generator)
 
-### Plots
+ncol = length(unique(df_plot.dataset))
+nrow = length(unique(df_plot.name))
 
-```{julia}
-using Serialization
-results = Serialization.deserialize(joinpath(output_path,"results_real_world.jls"))
-```
+using RCall
+scale_ = 2.0
+R"""
+library(ggplot2)
+plt <- ggplot($df_plot) +
+    geom_bar(aes(x=n, y=mean, fill=generator), stat="identity", alpha=0.5, position="dodge") +
+    geom_pointrange( aes(x=n, y=mean, ymin=ymin, ymax=ymax, colour=generator), alpha=0.9, position=position_dodge(width=0.9), size=0.5) +
+    facet_grid(
+        rows = vars(name),
+        cols =  vars(dataset), 
+        scales = "free_y"
+    ) +
+    labs(y = "Value") + 
+    scale_fill_discrete(name="Generator:") +
+    scale_colour_discrete(name="Generator:") +
+    theme(
+        axis.title.x=element_blank(),
+        axis.text.x=element_blank(),
+        axis.ticks.x=element_blank(),
+        legend.position="bottom"
+    ) +
+    guides(fill=guide_legend(ncol=3))
+temp_path <- file.path(tempdir(), "plot.png")
+ggsave(temp_path,width=$ncol * $scale_,height=$nrow * $scale_ * 0.85) 
+"""
 
-```{julia}
-using Images
-line_charts = Dict()
-errorbar_charts = Dict()
-for (data_name, res) in results
-    plt = plot(res)
-    Images.save(joinpath(www_path, "line_chart_latent_$(data_name).png"), plt)
-    line_charts[data_name] = plt
-    plt = plot(res,maximum(res.output.n))
-    Images.save(joinpath(www_path, "errorbar_chart_latent_$(data_name).png"), plt)
-    errorbar_charts[data_name] = plt
-end
+img = Images.load(rcopy(R"temp_path"))
+Images.save(joinpath(www_path,"paper_real_world_results.png"), img)
 ```
-

dev/notebooks/real_world.qmd

@@ -17,8 +17,14 @@ www_path = www_dir("real_world")
 ```
 
 ```{julia}
-max_obs = 1000
+max_obs = 2500
 data_sets = AlgorithmicRecourseDynamics.Data.load_real_world(max_obs)
+choices = [
+    :cal_housing, 
+    :credit_default, 
+    :gmsc, 
+]
+data_sets = filter(p -> p[1] in choices, data_sets)
 ```
 
 ```{julia}
@@ -63,12 +69,13 @@ n_rounds = 50
 evaluate_every = Int(round(n_rounds/n_evals))
 n_folds = 5
 n_bootstrap = 1
+n_samples = 10000
 T = 250
 generative_model_params = (epochs=250, latent_dim=8)
 using Serialization
 results = run_experiments(
     experiments;
-    save_path=output_path,evaluate_every=evaluate_every,n_rounds=n_rounds, n_folds=n_folds, n_bootstrap=n_bootstrap, T=T,
+    save_path=output_path,evaluate_every=evaluate_every,n_rounds=n_rounds, n_folds=n_folds, n_bootstrap=n_bootstrap, T=T, n_samples=n_samples,
     generative_model_params=generative_model_params
 )
 Serialization.serialize(joinpath(output_path,"results.jls"),results)
@@ -93,11 +100,63 @@ for (data_name, res) in results
 end
 ```
 
-### Table in paper
+### Chart in paper
 
 ```{julia}
-using AlgorithmicRecourseDynamics: kable
-kable(results, [50])
+using DataFrames, Statistics
+model_ = :FluxEnsemble
+df = DataFrame() 
+for (key, val) in results
+    df_ = deepcopy(val.output)
+    df_.dataset .= key
+    df = vcat(df,df_)
+end
+df = df[df.n .== maximum(df.n),:]
+df = df[df.model .== model_,:]
+filter!(:value => x -> !any(f -> f(x), (ismissing, isnothing, isnan)), df)
+gdf = groupby(df, [:generator, :dataset, :n, :name, :scope])
+df_plot = combine(gdf, :value => (x -> [(mean(x),mean(x)+std(x),mean(x)-std(x))]) => [:mean, :ymax, :ymin])
+df_plot = df_plot[[name in [:mmd, :model_performance] for name in df_plot.name],:]
+df_plot = mapcols(x -> typeof(x) == Vector{Symbol} ? string.(x) : x, df_plot)
+df_plot.name .= [r[:name] == "mmd" ? "$(r[:name])_$(r[:scope])" : r[:name] for r in eachrow(df_plot)]
+transform!(df_plot, :dataset => (X -> [x=="cal_housing" ? "California Housing" : x for x in X]) => :dataset)
+transform!(df_plot, :dataset => (X -> [x=="credit_default" ? "Credit Default" : x for x in X]) => :dataset)
+transform!(df_plot, :dataset => (X -> [x=="gmsc" ? "GMSC" : x for x in X]) => :dataset)
+transform!(df_plot, :name => (X -> [x=="mmd_domain" ? "MMD (domain)" : x for x in X]) => :name)
+transform!(df_plot, :name => (X -> [x=="mmd_model" ? "MMD (model)" : x for x in X]) => :name)
+transform!(df_plot, :name => (X -> [x=="model_performance" ? "Performance" : x for x in X]) => :name)
+transform!(df_plot, :generator => (X -> [x=="REVISE" ? "Latent" : x for x in X]) => :generator)
+
+ncol = length(unique(df_plot.dataset))
+nrow = length(unique(df_plot.name))
+
+using RCall
+scale_ = 1.75
+R"""
+library(ggplot2)
+plt <- ggplot($df_plot) +
+    geom_bar(aes(x=n, y=mean, fill=generator), stat="identity", alpha=0.5, position="dodge") +
+    geom_pointrange( aes(x=n, y=mean, ymin=ymin, ymax=ymax, colour=generator), alpha=0.9, position=position_dodge(width=0.9), size=0.5) +
+    facet_grid(
+        rows = vars(name),
+        cols =  vars(dataset), 
+        scales = "free_y"
+    ) +
+    labs(y = "Value") + 
+    scale_fill_discrete(name="Generator:") +
+    scale_colour_discrete(name="Generator:") +
+    theme(
+        axis.title.x=element_blank(),
+        axis.text.x=element_blank(),
+        axis.ticks.x=element_blank(),
+        legend.position="bottom"
+    )
+temp_path <- file.path(tempdir(), "plot.png")
+ggsave(temp_path,width=$ncol * $scale_,height=$nrow * $scale_ * 0.8) 
+"""
+
+img = Images.load(rcopy(R"temp_path"))
+Images.save(joinpath(www_path,"paper_real_world_results.png"), img)
 ```