# INFO-F-422 -  Statistical Foundations of Machine Learning

>### Student 1 - __[jules.nicolas-thouvenin@ulb.be](mailto:jules.nicolas-thouvenin@ulb.be) - Student ID 000528423__ / Driven Data Id : JulesNT
>### Student 2 - __[lucas.baussay@ulb.be](mailto:lucas.baussay@ulb.be) - Student ID 000528422__ / Driven Data Id : LucasBaussay
>### Student 3 - __[mathilde.havard-sedeno@ulb.be](mailto:mathilde.havard-sedeno@ulb.be) - Student ID 000528421__ / Driven Data Id : mhavardsedeno

>### Video presentation: https://youtu.be/rOhgU5WBHB8

>### Driven Data team : The French Dowsers

## Pump it Up : Data Mining the Water Table

```R
library(tidyverse)
library(greybox)
library(rpart)
library(randomForest)
library(ramify)
library(nnet)
library(devtools)
library(dummies)
library(ggplot2)
library(dplyr)
library(caret)
library(xgboost)
```

## Generic tools for the execution

```R
showMissingValues <- function(data,categorical_names) {
    missingVec = c()
    ratioVec = c()
    names = c()
    for (name in categorical_names) {
        nbMissingValues = sum(data[,name]=="")
        ratio = nbMissingValues/nrow(data)*100
        tryCatch(
            expr = {
                if (nbMissingValues > 0) {
                    missingVec = c(missingVec,nbMissingValues)
                    ratioVec = c(ratioVec,ratio)
                    names = c(names,name)
                }
            },
            error = function(e){},
            warning = function(w){},
            finally = {}
        )
    }
    table.results <- data.frame(feature=names,missing.values=missingVec,percentage.missing=ratioVec)
    return (table.results)
}

cramerAssociation <- function(data,categorical_names,threshold) {
    options(warn=-1)
    result = c()
    names = c()
    for (name in categorical_names) {
        cramer_value <- cramer(data[,name],data[,"status_group"])$value
        if (cramer_value < threshold){
            result = c(result,toString(cramer(data[,name],data[,"status_group"])$value))
            names = c(names,name)
        }
    }
    options(warn=0)
    table.results <- data.frame(features = names, association.statusgroup = result)
    return(table.results)
}

crossTableAssociation <- function(data,categorical_names,treshold){
    for(i in 1:length(categorical_names)) {
        var_name_1 = categorical_names[i]
        if (i < length(categorical_names)) {
            for(j in (i+1):length(categorical_names)) {
                var_name_2 = categorical_names[j]
                value <- cramer(data[,var_name_1],data[,var_name_2])$value
                if (value > treshold) {
                    cat(paste("[",var_name_1,"] is associated with [",var_name_2,"] -> ",value,"\n"))
                }
            }
        }
    }
}
```

# Predicting functional state of water-pumps in Tanzania

> Tanzania has been in a water crisis for several years now. Even though the country partly includes three of the Great African Lakes, a third of Tanzania is arid desert. According to the most recent survey, almost half of the population doesn’t have access to safe water. This leads to several problem, not only about health and hygiene. Since women and children have to walk longer to collect water, it also impacts the access to education, the economic status and the happiness in the country.

> One of the answer to this crisis is the installation of water pump all across the country. Plenty of data about it is available in a large database. In order to acknowledge the status of theses water-pumps, a survey was conducted by the ministry of water. This resulted in the classification of the pumps in three categories : functional, requires repair work and not functional.

> Our goal today is to analyze the dataset provided and use prediction models in order to predict the state of the water-pumps. If we are able to correctly predict the state of the water-pump, this could save precious time and money to the government.

# Loading and exploring the data

>The features of the dataset are documented on the page of the competition : [Features description](https://www.drivendata.org/competitions/7/pump-it-up-data-mining-the-water-table/page/25/)

```R
train <- read.csv("../data/TrainingSetValues.csv")
trainLabels <- read.csv("../data/TrainingSetLabels.csv")
test <- read.csv("../data/TestSetValues.csv")
```

## Dimensions of the dataset

```R
dim(train)
dim(test)
```

59400

40

14850

40

## Structure of the dataset

### Quick look at the features values

>We can see a lot more categorical features than numeric ones.

```R
#head(train)
```

### Distribution of the target feature

> We observe here a strong inbalance between the different outputs.

```R
table(trainLabels$status_group)
plot(trainLabels$status_group)
```

### Types of the features and number of factors

>The use of the function str() shows that :
>- most features are categorical features and some of them have a huge number of factors.
>- some groups of features apparently describe the same information (e.g. region and region_code)

```R
#str(train)
```

```R
#summary(train)
```

# Data preprocessing

>#### Main objective : maintain a good accuracy while reducing computation time and overfitting
>- Remove features and factors that don't bring new information to the model
>- Add more relevent features

>#### Here are the main parts of the preprocessing pipeline :
>- Combining the training set and the test set
>- Handling missing values
>- Reducing levels of categorical features
>- Format dates
>- Remove obviously useless features
>- Remove features little associated with target value
>- Identify similar features and choose only one per group

## Combining the training set and the test set

>This way the training and test set have the same factors and we don't encounter problems when predicting the test labels with the model. If we don't combine the two sets and the test set contains new factors, the model won't be able to predict anything.

```R
dataSet <- rbind(train,test)

dim(dataSet)
```

74250

40

>The following will help targeting a certain type of feature

```R
categorical_columns <- c(3,4,6,9,11,12,13,16,17,19,20,21,22,23,c(25:ncol(dataSet)))
categorical_names <- names(dataSet)[categorical_columns]
missing_values_alias <- c("none","None","No","no","0","Unknown",
                          "unknown","Not known","Not Known","not known",
                          "missing","Missing")
```

## Handling missing values

### Harmonize the dataset

>First we replace alias of missing values (e.g. none, no, unknown) by the value "" to harmonize the dataSet. Indeed, in the feature "funder" a NA was initially described by the values "", "none", "Unknown", "0", "Not Known" and "No". It's thus important to only have one specific value across all the dataset.

```R
for (var in categorical_columns[categorical_columns!=9 & categorical_columns!=38 & (categorical_columns < 28 | categorical_columns > 36)]) {
    for (alias in missing_values_alias) {
        dataSet[var][dataSet[var]==alias] <- ""
    }
}
dataSet <- droplevels(dataSet)
```

### Proportion of missing values

> In this section we compute the percentage of missing values for each feature that contains missing values.

```R
table.results <- showMissingValues(dataSet,categorical_names)
sorted.results <- table.results[order(table.results$missing.values,decreasing=T),]
sorted.results
ggplot(sorted.results,aes(x=percentage.missing,reorder(feature,percentage.missing)))+geom_bar(stat ="identity") + theme_light()
```

### Removing features that contains more than 20% of missing values

>scheme_name contains 47% of missing values, we remove it from the dataSet and see how many rows still contain missing values.

```R
data <- dataSet
data[data==""] <- NA
dim(na.omit(data))

dataSet <- dataSet[, -which(names(dataSet) == "scheme_name")]

data <- dataSet
data[data==""] <- NA
dim(na.omit(data))
```

33846

40

59764

39

### Conclusion on missing values

>Because we have to give a prediction on each of the individuals present in the test set, we can't remove lines from the dataset.

>Thus we have to choose between imputing missing values and treating them as a separate category for each variable. The two options have their downsides, mostly adding bias to the data.

>We choose to treat them as a separate category.

## Reducing levels of categorical features

>Some categorical features have a lot of factors. A large number of factors leads to high computation times and overfitting. Thus, those factors need to be reduced before handling the data to the model.

>Finding a maximum number of factors is like making a trade of between underfitting and overfitting.

>In the following we plot the frequencies of the 50 most frequent factors in each variable. This helps visualize how many factors we need to keep. The factor selection possess two objectives. The idea here is to minimize the number of factors we keep while maximizing the number of frequent factors we keep.

>The method to reduce factors is the following : we observed the frequencies of the most frequent factors and selected the minimum number of factors that really stand out from the others. To sum up, we got rid of all the factors that were too little frequent. We used plots to visualise.

>In the code section below, we show too different types of plots. The first shows a lot of useless factors that are going to be removed, the second one shows much less useless factors.

```R
# Very flat distribution from 5 to 50
plot(summary(dataSet$installer)[1:50])
# Fairly steep decreasing slope
plot(summary(dataSet$subvillage)[1:50])
```

>According to the plots we saw, we set a maximum number of factors for each feature. All the ones that are being removed are replaced by a factor "Other"

```R
factors_names = c("installer","funder","wpt_name",
                  "subvillage","lga","ward","extraction_type_class",
                  "extraction_type","extraction_type_group",
                  "quantity","quantity_group","waterpoint_type","waterpoint_type_group")
nb_levels = c(5,5,6,9,9,9,4,8,7,4,4,4,4) # + 1

names = list(
    installer_names = names(summary(dataSet$installer)[1:nb_levels[1]]),
    funder_names <- names(summary(dataSet$funder)[1:nb_levels[2]]),
    wpt_name_names <- names(summary(dataSet$wpt_name)[1:nb_levels[3]]),
    subvillage_names <- names(summary(dataSet$subvillage)[1:nb_levels[4]]),
    lga_names <- names(summary(dataSet$lga)[1:nb_levels[5]]),
    ward_names <- names(summary(dataSet$ward)[1:nb_levels[6]]),
    extraction_type_class_names <- names(summary(dataSet$extraction_type_class)[1:nb_levels[7]]),
    extraction_type_names <- names(summary(dataSet$extraction_type)[1:nb_levels[8]]),
    extraction_type_group_names <- names(summary(dataSet$extraction_type_group)[1:nb_levels[9]]),
    t1 <- names(summary(dataSet$quantity)[1:nb_levels[10]]),
    t2 <- names(summary(dataSet$quantity_group)[1:nb_levels[11]]),
    t3 <- names(summary(dataSet$waterpoint_type)[1:nb_levels[12]]),
    t4 <- names(summary(dataSet$waterpoint_type_group)[1:nb_levels[13]])
)

index = 1
for (var in factors_names){
    variable <- factor(dataSet[,var], levels=c(unlist(unname(names[index])), "Other"))
    variable[is.na(variable)] <- "Other"
    dataSet[,var] <- variable
    index = index + 1
}
```

## Format dates

>In the dataset, date_recorded is a categorical feature in the format : "year-month-day". This format can't truly be interpreted by a model. Indeed, the model can't extract, from this format, the useful informations like year, month, day. We thus need to remove this variable format and replace it by a new one.

>There are at least two ways to modify the format of the date :
>- We can add tree new features, year, month and day. This way the model can exactly know when the line was recorded.
>- We can add a new feature describing the number of days that have passed between the date and the oldest date in the dataset (we set the lower bound to 2001-01-01)

>Each method brings information that the other doesn't. For instance, the first one explicitly differenciate time entities like months and years. If a month is highly correlated with a status "non_functional", the model will quickly know about it. In the other hand, it is easier with the second method to know precisely how old is the date recording.

>We choose to create all the four new features and wait for the futures analysis to tell us if some features need to be removed.

>We leave the feature contruction_year unchanged because having an integer to describe the year of the pump construction is already a good thing.

```R
# Computing the new features
days_since_2001 <- as.numeric(as.Date(dataSet$date_recorded) - as.Date("2001-01-01"))
year_recorded <- as.numeric(format(as.Date(dataSet$date_recorded), "%Y"))
month_recorded <- as.numeric(format(as.Date(dataSet$date_recorded), "%m"))
day_recorded <- as.numeric(format(as.Date(dataSet$date_recorded), "%d"))
# Removing the old feature
dataSet <- dataSet[, -which(names(dataSet) == "date_recorded")]
# Adding the new features to the dataset
dataSet <- cbind(dataSet, year_recorded)
dataSet <- cbind(dataSet, month_recorded)
dataSet <- cbind(dataSet, day_recorded)
dataSet <- cbind(dataSet, days_since_2001)
```

## Remove obviously useless features

>Here we remove features that are clearly useless for the learning process :
>- num_private has not documentation and is full of zeros.
>- recorded_by is constant

>##### IMPORTANT : we won't use the id feature when running the model, but we need it on the dataSet to identify lines. We remove id just before running a model, inside the learning functions.

```R
dataSet <- dataSet[, -which(names(dataSet) == "num_private")]
dataSet <- dataSet[, -which(names(dataSet) == "recorded_by")]
```

## Remove features little associated with target value

>In this section we use the cramer V measure of association between two categorical features. The function cramerAssociation(data,features_studied,threshold), defined at the beginning of the notebook, computes the cramer V association between the features and the target value, and prints all the features that have an association value smaller than 0.2.

>The cramer V is not designed to measure association between continuous and categorical features, but we didn't find another measure that worked for us. Point biserial correlation is only taking binary features instead of categorical features, and Pearson’s correlation coefficient is only taking continous features. Thus, the results on the association between continous features like amout_tsh and the target value are to be studied carefully.

>The Cramer's V measure of association is computed as follows :

\begin{align}
V & = 𝑠𝑞𝑟𝑡(\frac{𝜒2}{(𝑛𝑞−1)}) \\
q & = min(nrow,ncol) \\
n & = grand.total.of.observations
\end{align}

```R
train <- dataSet[1:nrow(train),]
test <- dataSet[(nrow(train)+1):nrow(dataSet),]

train <- merge(train,trainLabels)

table.results <- cramerAssociation(train,names(train),threshold=0.2)

head(table.results)

# See all the values
# table.results
```

A data.frame: 6 × 2

	features	association.statusgroup

	<fct>	<fct>

1	amount_tsh	0.190409702925686

2	funder    	0.0965788493742786

3	installer 	0.106093292786878

4	wpt_name  	0.0732455779022614

5	basin     	0.127162580061

6	subvillage	0.0302729482305235

```R
# Remove features less associated with target value than 20%
for (name in table.results$features) {
    dataSet <- dataSet[, -which(names(dataSet) == name)]
}
```

```R
dim(dataSet)
```

74250

12

## Identify similar features and choose only one per group

>In this section, we look at the association between paired features to identify groups of similar features. We set the association threshold to 0.75, meaning the function crossTableAssociation will signal similar features if their cramer V association is greater than 0.75.

>We want to take only one variable per group.

```R
categorical_names = c("region","extraction_type_group",
                      "extraction_type_class","quantity",
                      "quantity_group","waterpoint_type_group")
crossTableAssociation(dataSet,categorical_names,0.75)
```

    [ extraction_type_group ] is associated with [ extraction_type_class ] ->  0.925697664597424
    [ quantity ] is associated with [ quantity_group ] ->  1

>We thus keep only the best variable of each group of similar features. We keep the one having the highest association with the target value.

```R
table.results <- cramerAssociation(train,names(train),threshold=1)
table.results[table.results$features=="quantity" | table.results$features=="quantity_group" |
              table.results$features=="extraction_type_group" | table.results$features=="extraction_type_class",]
```

A data.frame: 4 × 2

	features	association.statusgroup

	<fct>	<fct>

22	extraction_type_group	0.246152363371028

23	extraction_type_class	0.241041272903453

30	quantity             	0.309239970561213

31	quantity_group       	0.309239970561213

>We choose **extraction_type_group** and **quantity**

```R
dataSet <- dataSet[, -which(names(dataSet) == "quantity_group")]
dataSet <- dataSet[, -which(names(dataSet) == "extraction_type_class")]
```

>We also remove the variable region_code that is clearly a alias of region.

```R
dataSet <- dataSet[, -which(names(dataSet) == "region_code")]
```

## Last check on the data

>Here we give a last look to the data, making sure that:
>- features have few levels
>- features have an association with status_group greater than 20%.

```R
train <- dataSet[1:nrow(train),]
test <- dataSet[(nrow(train)+1):nrow(dataSet),]

train <- merge(train,trainLabels)

head(train)

dim(train)
dim(test)

str(train)

cat(paste("\n"))

cramerAssociation(train,names(train[,-1]),1)
```

A data.frame: 6 × 10

	id	gps_height	longitude	latitude	region	extraction_type_group	quantity	waterpoint_type_group	days_since_2001	status_group

	<int>	<int>	<dbl>	<dbl>	<fct>	<fct>	<fct>	<fct>	<dbl>	<fct>

1	0	   0	33.12583	-5.118154	Tabora     	afridev    	enough      	hand pump         	4334	non functional

2	1	1978	34.77072	-9.395642	Iringa     	Other      	enough      	hand pump         	3715	functional

3	2	   0	36.11506	-6.279268	Dodoma     	mono       	insufficient	communal standpipe	3737	functional

4	3	1639	37.14743	-3.187555	Kilimanjaro	gravity    	enough      	communal standpipe	4536	functional

5	4	   0	36.16489	-6.099289	Dodoma     	nira/tanira	dry         	hand pump         	3732	non functional

6	5	  28	39.28612	-6.972403	Pwani      	Other      	enough      	communal standpipe	3708	functional

59400

10

14850

9

    'data.frame':	59400 obs. of  10 variables:
     $ id                   : int  0 1 2 3 4 5 6 7 8 9 ...
     $ gps_height           : int  0 1978 0 1639 0 28 0 0 0 0 ...
     $ longitude            : num  33.1 34.8 36.1 37.1 36.2 ...
     $ latitude             : num  -5.12 -9.4 -6.28 -3.19 -6.1 ...
     $ region               : Factor w/ 21 levels "Arusha","Dar es Salaam",..: 20 4 3 7 3 15 18 3 3 5 ...
     $ extraction_type_group: Factor w/ 8 levels "afridev","gravity",..: 1 8 5 2 6 8 7 7 5 5 ...
     $ quantity             : Factor w/ 5 levels "dry","enough",..: 2 2 3 2 1 2 4 3 1 3 ...
     $ waterpoint_type_group: Factor w/ 5 levels "cattle trough",..: 4 4 2 2 4 2 5 5 2 2 ...
     $ days_since_2001      : num  4334 3715 3737 4536 3732 ...
     $ status_group         : Factor w/ 3 levels "functional","functional needs repair",..: 3 1 1 1 3 1 3 1 3 3 ...

A data.frame: 8 × 2

features	association.statusgroup

<fct>	<fct>

gps_height           	0.229910915501276

longitude            	0.974333782951389

latitude             	0.974343380825274

region               	0.200895116574615

extraction_type_group	0.246152363371028

quantity             	0.309239970561213

waterpoint_type_group	0.202465159819959

days_since_2001      	0.205269653564557

## The data is ready !

# 2) Model selection

>In this section we estimate the accuracy of three different models, using the preprocessed data constructed in part 1.

>The models we will study are :
>- **single-hidden-layer neural network**
>- **decision tree**
>- **random forest**

>We estimate the classification rate of each model by running a **10 fold cross validation** procedure, except for the random forest because of the high computation cost. We thus operate a **5 fold cross validation** to validate the random forest model, to avoid a crash from jupyter kernel.

## Choose your execution parameter

>You can set the parameter **EXECUTION** to a value between 1,2 and 3. One being the minimal run, and 3 the expensive one. By default the parameter is set to 2, where all the important algorithms are called.

```R
#EXECUTION <- 1 # MINIMAL : all the lines that take more than 1 minute of compilation won't run (VERY FAST)
EXECUTION <- 2 # NORMAL : all the main algorithms will run, but the hyperparameters tunings won't
#EXECUTION <- 3 # LONG : all the lines will run (VERY EXPENSIVE)
```

### Single-Hidden-Layer neural network

>The single-hidden-layer neural network structure is explicit. The model is a neural network containing only one hidden layer. We choose to allow skip connections (parameter skip = TRUE) to minimize vanishing gradient.

>Because the performance of this model highly depends on it's number of nodes, we choose to study the impact of the number of nodes on the classification rate. To limit computation time, we don't go further than 10 hidden nodes, testing only 3, 5 and 10 hidden nodes.

>We obtain the best results (classification rate around 60%) with 5 hidden nodes. You can verify this by running the **neural_network_optimize_hidden_nodes(data,list_nodes)**, wich takes some time to execute.

>We choose to use integer encoding for the categorical features. The nnet function automatically encode the categorical features using integer encoding. Thus we don't need to modify our existing data before giving it to the nnet model.

```R
neural_network_fold_cross_validation <- function(trainingSet,k,nb_hidden_nodes) {

    # INITIALISATION

    start_time <- Sys.time()
    # removing column id in dataset
    trainingSet <- trainingSet[, -which(names(trainingSet) == "id")]
    # indexing status_group
    target_variable <- ncol(trainingSet)
    # vector storing the classification rates
    classification_rate <- array(0,k)
    # shuffle trainingSet
    train_idx <- sample(1:nrow(trainingSet))
    # split the trainingset into k groups
    max <- ceiling(nrow(trainingSet)/k)
    splits <- split(train_idx, ceiling(seq_along(train_idx)/max))

    # 10 FOLD CROSS VALIDATION

    for (i in 1:k){
        # separate the training set from the fold test set
        test_data <- trainingSet[splits[[i]],]
        train_data <- trainingSet[-splits[[i]],]

        # Fit the model to the training set
        model <- model <- nnet(status_group ~ .,
                                 data=train_data,
                                 size=nb_hidden_nodes,
                                 skip=TRUE,
                                 MaxNWts=10000,
                                 trace=F)

        # Predict the label of test_data
        Y_pred <- predict(model,test_data[,-target_variable])
        Y_hat <- ifelse(Y_pred[,1] >= Y_pred[,2] & Y_pred[,1] >= Y_pred[,3],
                     "functional",
                     ifelse(Y_pred[,2] >= Y_pred[,3], "functional needs repair", "non functional"))

        # True label
        Y <- test_data[,target_variable]

        # Compute confusion matrix
        confusion_matrix <- table(Y_hat,Y)

        # Compute the classification rate
        if ((dim(confusion_matrix)[1]) == 1){
            classification_rate[i] = (confusion_matrix[1,1])/length(Y)
        } else if((dim(confusion_matrix)[1]) == 2) {
            classification_rate[i] = (confusion_matrix[1,1]+confusion_matrix[2,2])/length(Y)
        } else {
            classification_rate[i] = (confusion_matrix[1,1]+confusion_matrix[2,2]+confusion_matrix[3,3])/length(Y)
        }
    }

    end_time <- Sys.time()
    print(end_time - start_time)

    return(mean(classification_rate))
}
```

```R
neural_network_optimize_hidden_nodes <- function(trainingSet,k,values_hidden_nodes) {
    classification_rate <- c()
    # Computing a 10 fold cross validation for each number of hidden nodes
    for (nb_hidden_nodes in values_hidden_nodes) {
        classification_rate <- c(classification_rate,neural_network_fold_cross_validation(trainingSet,k,nb_hidden_nodes))
    }
    cat(paste("\nClassification rates :\n"))
    print(classification_rate)
    plot(classification_rate)
    bestIndex <- argmax(mat(classification_rate,nrow=1))
    bestClassificationRate <- max(classification_rate)
    cat(paste("The neural network works best with",
              values_hidden_nodes[bestIndex],
              "hidden nodes, obtaining a classification rate of",bestClassificationRate))
    return(bestClassificationRate)
}
```

```R
if (EXECUTION == 2) {
    accuracy_nn = neural_network_fold_cross_validation(train,10,5)
    accuracy_nn
}

if (EXECUTION == 3) {
    best_accuracy_nn = neural_network_optimize_hidden_nodes(train,10,c(3,5,10))
    best_accuracy_nn
}
```

    Time difference of 2.009154 mins

0.596700336700337

## Decision tree

>This model is a simple single decision tree. We chose this model to better illustrate the improvement of the random forest over a single tree.

>Tunning of hyperparameters : we studied the impact of the depth of the tree over the classification rate. We obtained best results with ??? (classification rate around ???%). You can replicate this experiment by running the function **decision_tree_optimize_depth(data,list_depths,verbose)**, which again is quite expensive in terms of computation times.

```R
decision_tree_fold_crossValidation <- function(trainingSet,k,depth,verbose) {

    # INITIALISATION

    start_time <- Sys.time()
    # removing column id in dataset
    trainingSet <- trainingSet[, -which(names(trainingSet) == "id")]
    # indexing status_group
    target_variable <- ncol(trainingSet)
    # vector storing the classification rates
    classification_rate <- array(0,k)
    # Shuffle trainingSet
    train_idx <- sample(1:nrow(trainingSet))
    # Split the dataset into k groups
    max <- ceiling(nrow(trainingSet)/k)
    splits <- split(train_idx, ceiling(seq_along(train_idx)/max))

    # 10 FOLD CROSS VALIDATION

    for (i in 1:k){
        # separate the training set from the fold test set
        test_data <- trainingSet[splits[[i]],]
        train_data <- trainingSet[-splits[[i]],]

        # Fit the model to the training set
        model <- rpart(status_group ~ ., method="class",data=train_data,control = list(maxdepth = depth))

        if (i == 1 & verbose) {
            plot(model, uniform=TRUE, main="Classification Tree - Rpart")
            text(model, use.n=TRUE, all=TRUE, cex=.8)
        }

        # Predict the label of test_data
        Y_pred <- predict(model,test_data[,-target_variable])
        Y_hat <- ifelse(Y_pred[,1] >= Y_pred[,2] & Y_pred[,1] >= Y_pred[,3],
                     "functional",
                     ifelse(Y_pred[,2] >= Y_pred[,3], "functional needs repair", "non functional")
                    )
        # True label
        Y <- test_data[,target_variable]

        # Compute confusion matrix
        confusion_matrix <- table(Y_hat,Y)

        # Compute the classification rate
        if ((dim(confusion_matrix)[1]) == 1){
            classification_rate[i] = (confusion_matrix[1,1])/length(Y)
        } else if((dim(confusion_matrix)[1]) == 2) {
            classification_rate[i] = (confusion_matrix[1,1]+confusion_matrix[2,2])/length(Y)
        } else {
            classification_rate[i] = (confusion_matrix[1,1]+confusion_matrix[2,2]+confusion_matrix[3,3])/length(Y)
        }
    }

    end_time <- Sys.time()
    print(end_time - start_time)
    return(mean(classification_rate))
}
```

```R
decision_tree_optimize_depth <- function(trainingSet,k,values_depth,verbose) {
    classification_rate <- c()
    # Computing a 10 fold cross validation for each depth
    for (depth in values_depth) {
        classification_rate <- c(classification_rate,decision_tree_fold_crossValidation(trainingSet,k,depth,verbose))
    }
    cat(paste("\nClassification rates :\n"))
    print(classification_rate)
    plot(classification_rate)
    bestIndex <- argmax(mat(classification_rate,nrow=1))
    bestClassificationRate <- max(classification_rate)
    cat(paste("The decision tree works best with a depth equal to",
              values_depth[bestIndex],
              ", obtaining a classification rate of",bestClassificationRate))
    return(bestClassificationRate)
}
```

```R
if (EXECUTION == 2) {
    accuracy_dt <- decision_tree_fold_crossValidation(train,10,9,verbose=TRUE)
    cat(paste("Classification rate :",accuracy_dt))
}

if (EXECUTION == 3) {
    best_accuracy_dt <- decision_tree_optimize_depth(train,10,c(3,5,7,9,11,13,15,17,19,21),verbose=FALSE)
    best_accuracy_dt
}
```

## Random forest

>The random forest builds several decision trees, using for each one a random number of features. The output of the model is obtained by passing the input inside each tree. The output that is the more frequent is considered the final output.

>For this model, because of the big computation times, we don't dive into hyperparameters tuning, leaving the default values.

```R
random_forest_fold_cross_validation <- function(trainingSet,k,verbose) {

    # INITIALISATION

    start_time <- Sys.time()

    # removing column id in dataset
    trainingSet <- trainingSet[, -which(names(trainingSet) == "id")]
    # indexing status_group
    target_variable <- ncol(trainingSet)
    # vector storing the classification rates
    classification_rate <- array(0,k)
    # Shuffle trainingSet
    train_idx <- sample(1:nrow(trainingSet))
    # Split the dataset into k groups
    max <- ceiling(nrow(trainingSet)/k)
    splits <- split(train_idx, ceiling(seq_along(train_idx)/max))

    # 10 FOLD CROSS VALIDATION

    for (i in 1:k){
        # separate the training set from the fold test set
        test_data <- trainingSet[splits[[i]],]
        train_data <- trainingSet[-splits[[i]],]

        # Fit the model to the training set
        model <- randomForest(status_group ~ ., method="class",data=train_data)

        # get the importance of the features in predicting the target value
        importance = varImp(model)

        # print the importances (only for the first iteration)
        if (verbose & i == 1) {
            perm <- order(importance$Overall,decreasing=T)
            column_name = importance[perm,0]
            column_number = importance[perm,1]
            ordered_importance <- data.frame(column_name = column_name, column_number=column_number)
        }

        # Predict the label of test_data
        Y_pred <- predict(model,test_data[,-target_variable])

        # True label
        Y <- test_data[,target_variable]

        # Compute confusion matrix
        confusion_matrix <- table(Y_pred,Y)

        # Compute the classification rate
        if ((dim(confusion_matrix)[1]) == 1){
            classification_rate[i] = (confusion_matrix[1,1])/length(Y)
        } else if((dim(confusion_matrix)[1]) == 2) {
            classification_rate[i] = (confusion_matrix[1,1]+confusion_matrix[2,2])/length(Y)
        } else {
            classification_rate[i] = (confusion_matrix[1,1]+confusion_matrix[2,2]+confusion_matrix[3,3])/length(Y)
        }
    }

    end_time <- Sys.time()
    print(end_time - start_time)
    return(list(accuracy=mean(classification_rate),importance=ordered_importance))
}
```

```R
if (EXECUTION >= 2) {
    results_rf <- random_forest_fold_cross_validation(train,5,verbose=TRUE)
    cat(paste("\nEstimated classification rate of the model\n"))
    results_rf$accuracy
}
```

    Time difference of 6.559793 mins

    Estimated classification rate of the model

0.789579124579125

```R
if (EXECUTION >= 2) {
    cat(paste("Importance of the features"))
    results_rf$importance
}
```

    Importance of the features

A data.frame: 8 × 1

	column_number

	<dbl>

quantity	3721.431

longitude	3242.447

latitude	3114.636

days_since_2001	2089.580

gps_height	1978.405

extraction_type_group	1848.405

waterpoint_type_group	1192.139

region	1033.124

## Discussion

>The tree models accessed in part 2 obtain very different results.

>First, the decision tree shows pretty bad results, predicting only 53% of correct target values. This behavior can be explain by the huge dimensionality reduction that has been done in part 1. The tree has not so many variables to work with and struggles in creating a powerful predictor.

>Second, the single-hidden-layer neural network works better than the decision tree, having a estimated classification rate up to 60%. The simple structure of the neural network is probably the reason that more precise rules haven't been discovered.

>At last, the random forest beats all records with a estimated classification rate equal to 79%. 20% above the neural network.

>If we needed to select a model from those three, it would be the random forest.

# 3) Learning procedure with Gradient Boosting (XGBOOST)

> In this chapter we will go back to another model validation procedure, this time acessing the classification rate of Gradient Boosting algorithm. We use the model implementation from the library **xgboost**.

## One-hot encoding

>Because the model xgboost only work on numeric features, we choose to encode the categorical features with one-hot encoding. Only the target value "status_group" will be encoded with integer encoding because xgboost doesn't allow multiple target features. We thus have 1 for functional, 2 for functional needs repair, and 3 for non functional.

## Model validation : 10 fold cross validation

>One more time, we choose to estimate our model classification rate by using a 10 fold cross validation method.

```R
xg_boost_fold_cross_validation <- function(trainingSet,k) {

    # INITIALISATION

    start_time <- Sys.time()

    # removing column id in dataset
    trainingSet <- trainingSet[, -which(names(trainingSet) == "id")]

    # encode factors into dummy variables (one-hot encoding)
    options(warn=-1)
    trainingSet <- cbind(trainingSet,dummy(trainingSet$region))
    trainingSet <- cbind(trainingSet,dummy(trainingSet$extraction_type_group))
    trainingSet <- cbind(trainingSet,dummy(trainingSet$quantity))
    trainingSet <- cbind(trainingSet,dummy(trainingSet$waterpoint_type_group))
    trainingSet <- trainingSet[,-c(4:8)]
    options(warn=0)

    # indexing status_group
    target_variable <- ncol(trainingSet)
    # vector storing the classification rates
    classification_rate <- array(0,k)
    # Shuffle trainingSet
    train_idx <- sample(1:nrow(trainingSet))
    # Split the dataset into k groups
    max <- ceiling(nrow(trainingSet)/k)
    splits <- split(train_idx, ceiling(seq_along(train_idx)/max))

    # 10 FOLD CROSS VALIDATION

    for (i in 1:k) {
        # separate the training set from the fold test set
        options(warn=-1)
        test_data <- trainingSet[splits[[i]],]
        label_test <- as.numeric(test_data$status_group)
        test_data <- test_data[, -which(names(test_data) == "status_group")]

        train_data <- trainingSet[-splits[[i]],]
        label_train <- as.numeric(train_data$status_group)
        train_data <- train_data[, -which(names(train_data) == "status_group")]
        options(warn=0)

        # make sure the data set is numeric
        test_data <- as.matrix(as.data.frame(lapply(test_data, as.numeric)))
        train_data <- as.matrix(as.data.frame(lapply(train_data, as.numeric)))

        # transform the dataset into a xgb.DMatrix for reasons of efficiency
        train.DMatrix <- xgb.DMatrix(data = train_data,label = label_train, missing = NA)

        # Fit the model to the training set
        model <- xgboost(data = train.DMatrix, objective = "multi:softmax", booster = "gbtree",
                         eval_metric="mlogloss", nrounds=10,num_class = 4,eta = .7,
                         max_depth = 14,colsample_bytree =1.,verbose=F)

        # print the importances of the features in predicting the target value (only for the first iteration)
        if (i == 1) {
            importance <- xgb.importance(feature_names = colnames(train_data), model = model)
            xgb.plot.importance(importance_matrix = importance)
        }

        # Predict the label of test_data
        Y_pred <- predict(model,test_data)
        Y_pred[Y_pred==1] <- "functional"
        Y_pred[Y_pred==2] <- "functional needs repair"
        Y_pred[Y_pred==3] <- "non functional"

        # True label
        label_test[label_test==1] <- "functional"
        label_test[label_test==2] <- "functional needs repair"
        label_test[label_test==3] <- "non functional"

        # Compute confusion matrix
        confusion_matrix <- table(Y_pred,label_test)

        # Compute the classification rate
        classification_rate[i] = (confusion_matrix[1,1]+
                                  confusion_matrix[2,2]+confusion_matrix[3,3])/length(label_test)
    }

    end_time <- Sys.time()
    print(end_time - start_time)

    return(mean(classification_rate))
}
```

```R
if (EXECUTION >= 2) {
    accuracy_xgb <- xg_boost_fold_cross_validation(train,10)
    cat(paste("\nEstimated classification rate of the model\n"))
    accuracy_xgb
}
```

> We are satisfied with this accuracy. We can thus launch the learning process.

## Learning phase

>Now we can run the model on the entire training set and apply this model to the test set to predict the missing labels.

```R
learning_xg_boost <- function(dataSet,lenTrain,train_labels) {
    start_time <- Sys.time()

    # store the id column of the dataset
    id_column <- dataSet$id
    # remove the id column
    dataSet <- dataSet[, -which(names(dataSet) == "id")]

    # encode the dataset using one-hot encoding
    options(warn=-1)
    dataSet <- cbind(dataSet,dummy(dataSet$region))
    dataSet <- cbind(dataSet,dummy(dataSet$extraction_type_group))
    dataSet <- cbind(dataSet,dummy(dataSet$quantity))
    dataSet <- cbind(dataSet,dummy(dataSet$waterpoint_type_group))
    dataSet <- dataSet[,-c(4:8)]
    options(warn=0)

    # split the dataset into training and test set (actual ones this time)
    train_set <- dataSet[1:lenTrain,]
    test_set  <- dataSet[(lenTrain+1):nrow(dataSet),]

    # encode target value using integer encoding
    label <- as.numeric(train_labels$status_group)

    # making sure the datasets are numeric
    train_set <- as.matrix(as.data.frame(lapply(train_set, as.numeric)))
    test_set <- as.matrix(as.data.frame(lapply(test_set, as.numeric)))

    # transforming training data into xgb.DMatrix
    train.DMatrix <- xgb.DMatrix(data = train_set,label = label, missing = NA)

    # learning time for the xgboost model
    model <- xgboost(data = train.DMatrix, objective = "multi:softmax", booster = "gbtree",eval_metric="mlogloss",
                     nrounds=10,num_class = 4,eta = .7,max_depth = 14,colsample_bytree =1.,verbose=F)

    # predict the labels of the testset
    Y_pred <- predict(model,test_set)
    Y_pred[Y_pred==1] <- "functional"
    Y_pred[Y_pred==2] <- "functional needs repair"
    Y_pred[Y_pred==3] <- "non functional"

    # associate each prediction with its id
    result <- data.frame(id=id_column[(lenTrain+1):nrow(dataSet)],status_group=Y_pred)

    cat(paste("Time spent : ",Sys.time() - start_time))

    return(result)
}
```

```R
result <- learning_xg_boost(dataSet,nrow(train),trainLabels)
```

    Time spent :  4.7666654586792

```R
write.csv(result,"../submissions/submisssion_9_vars_XGBOOST_whole_train.csv",quote=FALSE,row.names=FALSE)
```

# Submission to Driven Data

> We submited the csv file to the competition and obtained a classification rate of 78.49%

> The submission files are located in the folder submissions. There are four different submissions. The first ones are using Random Forest, there were used to check if our submission method was working.


```python
%load_ext autoreload
%autoreload 2

from copy import deepcopy
import os
import time
import pydrake
from pydrake.all import (
    CommonSolverOption,
    MathematicalProgram,
    MakeSolver,
    GurobiSolver,
    Solve,
    SolverOptions,
    VPolytope
)
import matplotlib.pyplot as plt
import networkx as nx
import numpy as np
import scipy as sp
from geometric_only_grammar import *
```

    The autoreload extension is already loaded. To reload it, use:
      %reload_ext autoreload

Minimal grammar definition: each node has:
- a pose x
- a type name

A node class defines:
- its child type (by name or None)
- max # of children
- the geometric stop prob p (1. = always 1 child, 0. = infinite children)
- the region in which children will be produced (uniformly at random), in the frame of the node, in the form of an axis-aligned bounding box

E.g. object groups in plane:
- Root node produces object clusters and uniform random locations inside [0, 1]^2.
- Each cluster produces up points uniformly in a 0.1-length box centered at the cluster center.

```python
# Grammar implementing clusters of points in 2D.
cluster_grammar = {
    "point": NodeDefinition(child_type=None, p=None, max_children=None, bounds=None),
    #"cluster_cluster": NodeDefinition(child_type="cluster", p=0.5, max_children=3, bounds=[-np.ones(2)*0.2, np.ones(2)*0.22]),
    "cluster": NodeDefinition(child_type="point", p=0.25, max_children=4, bounds=[-np.ones(2)*0.2, np.ones(2)*0.2]),
    "root": NodeDefinition(child_type="cluster", p=0.5, max_children=4, bounds=[np.ones(2)*0.2, np.ones(2)*0.8])
}
cluster_grammar_observed_types = ["point"]

np.random.seed(7)
example_tree = sample_tree(cluster_grammar)
observed_nodes = deepcopy(get_observed_nodes(example_tree, cluster_grammar_observed_types))

plt.figure().set_size_inches(8, 4)
plt.subplot(1, 2, 1)
draw_tree(example_tree)
plt.title("Full tree")
plt.subplot(1, 2, 2)
draw_observed_nodes(observed_nodes)
plt.title("Observed nodes")
```

```python

def make_super_tree(grammar):
    # Same logic as sampling a tree, but instead takes *all*
    # choices (but doesn't bother with sampling x).
    tree = nx.DiGraph()
    root = Node("root", x=np.array([0., 0.]))
    tree.add_node(root)
    node_queue = [root]

    while len(node_queue) > 0:
        parent = node_queue.pop(0)
        assert parent.type in grammar.keys()
        parent_def = grammar[parent.type]
        if parent_def.child_type is None:
            continue
        n_children = parent_def.max_children

        for k in range(n_children):
            child = Node(parent_def.child_type, np.zeros(2))
            tree.add_node(child)
            tree.add_edge(parent, child)
            node_queue.append(child)
    return tree
super_tree = make_super_tree(cluster_grammar)
draw_tree(super_tree, draw_pos=False)
plt.xlim([-2., 2.])
plt.ylim([-2., 2.])
plt.title("Super tree for cluster grammar")
```

# Posterior estimation on the super tree using full enumeration of trees

Now look at the full Bayesian form of scene parsing: given an observed scene $obs$ + a grammar description, find a representation of the posterior over parse trees $T$ for a given scene $obs$ that maximizes the (log) evidence:

$$ \log p(obs) = \log \left[ \sum_T p(obs | T) p(T)\right] $$

Now we need to worry about distributions over *whole trees*. Using the super-tree idea, we can describe any given tree as a binary vector $B = [b_1, ..., b_N]$ and continuous vector $C = [xy_1, ..., xy_N]$, concatenating the activation and xy variables for the $N$ nodes in the super tree. Distributions over trees are distributions over the joint space $p(B, C)$.

That space is nasty to represent, but we can try approximations -- here's a pretty exhaustive but expressive one:
1) For every distinct tree in the $2^N$ options (i.e. for each binary vector $B$), create decision variables as the parameters for a distribution over $C$. (i.e., fit a distribution for C for every distinct possible tree.)
2) Create $2^N$ continuous decision variables for the Categorical weights for a given tree / binary vector $B$ being chosen.

What distribution we use for $C$ probably depends on the grammar; maybe I can relate it to the variational approximation in VI.

The optimization becomes optimizing those parameters w.r.t.
$$
\begin{align}
\max \log p(obs) &= \log \left[ \sum_T p(obs | T) p(T) \right] \\
&\geq \sum_{T \, | \, p(obs | T) = 1 \, and \, p(T) > 0} \log p(T)
\end{align}$$

by dropping zero-probability terms from the sum and then applying Jensen's inequality. (In this situation, $p(obs | T)$ is still either 0 or 1, if the tree does or does node induce $obs$.)

Evaluation of $\log p(T)$ should be doable; the topology is fixed from the value for $B$, but the exact form of the parameter space for $C$ will decide how this is done.

Evaluation of $p(obs | T) = 1$ is a feasibility check: can the current tree produce the observation set? Importantly, this is a set-to-set evaluation: for each observed node, is the distance to the closest active node zero? (This requires a set of binary correspondence variables for each $T$...)

(I think that's going to create and explosion of variables, but we can try it.)

TODO(gizatt) IMPLEMENTATION BELOW IS TRASHY ABOUT COST: MIXES REGULAR PROB, LOG PROB, ETc.

KL divergence derivation:
Split $T$ into its discrete latent structure $B$; its continuous latent node positions $X$; and the latent-to-observed correspondences $C$.

Find $q(T)$ close to $p(T | o)$. Roughly following (6.1) in Ritchie's PhD thesis (but with a different setup) -- importantly, keeping the KL divergence ordering the same:
$$
\begin{align}
\min_\theta D_{KL}&(p(T | o) || q(T) \\
=& min_\theta \sum_{T} P(T | o) \log \dfrac{p(T | o)}{q(T)} \\
=& min_\theta \sum_{T \, s.t. \, P(T | o) > 0} P(T | o) \log p(T | o) - P(T | o) \log q_\theta(T) \\
=& max_\theta \sum_{T \, s.t. \, P(T | o) > 0} P(T | o) \log q_\theta(T) \\
=& max_\theta \sum_{\text{feasible } B} P(B) * \left[ \sum_{\text{feasible } X, C} P(X, C | o, B) \log q_{\theta}(B, X, C) \right]
\end{align}
$$
$q\theta(T)$ is parameterized by a set of weights $\theta^w$ over the feasible $B$, plus separate parameter sets $\theta^{XC}_i$ for variational posteriors over $X$ and $C$ for each feasible $B$.

In this strategy, we're taking the outer sum explicitly; but to estimate $P(X, C | o, B) \log q_\theta(B, X, C)$, we assume that posterior is concentrated at one optimal $X, C$ for each $o, B$, which we find and optimize jointly with $\theta$ in a MIP that looks like our oneshot parsing problem.

```python
# Make a super tree and observed node set, which we'll modify to organize our optimization variables.
def infer_tree_dist_by_tree_enum(grammar, base_observed_nodes, observed_node_types, verbose=False):
    setup_start_time = time.time()
    base_super_tree = make_super_tree(grammar)
    base_observed_nodes = deepcopy(base_observed_nodes)

    prog = MathematicalProgram()

    # Assumption here that super_tree.nodes is consistently ordered before;after deepcopy.
    # Testing real quick...
    copied_nodes = deepcopy(base_super_tree).nodes
    assert([n1.type == n2.type and np.allclose(n1.x, n2.x)
            for n1, n2 in zip(base_super_tree.nodes, deepcopy(base_super_tree).nodes)])

    # Give nodes consistent and easy-to-get indices.
    for k, node in enumerate(base_super_tree.nodes):
        node.ind = k
    n_nodes = len(base_super_tree.nodes)
    n_combinations = 2**n_nodes
    all_super_trees = []
    all_observed_nodes = []

    # Create categorical weights.
    #categorical_weights = prog.NewContinuousVariables(n_combinations, "categorical_weights")
    #prog.AddLinearConstraint(sum(categorical_weights) == 1.)
    #prog.AddBoundingBoxConstraint(0, 1, categorical_weights)

    for combo_k in range(n_combinations):
        # Convert int to binary with zero padding on the front.
        node_activations = [int(i) for i in format(combo_k, '#0%db' % (n_nodes+2))[2:]]
        assert(len(node_activations) == n_nodes)

        # Pre-check basic tree feasibility, and reject & set weight
        # to zero & add no additional variables if it fails.
        def active(node):
            return node_activations[node.ind]
        def is_feasible(node_activations):
            for parent in list(base_super_tree.nodes):
                children = list(base_super_tree.successors(parent))
                # Enforce > 0 children for active nonterminals to have no hanging nonterminals.
                if active(parent) and grammar[parent.type].child_type is not None and sum([active(c) for c in children]) == 0:
                    return False
                # Child active -> parent active.
                for child in children:
                    if active(child) and not active(parent):
                        return False
                # Child ordering legal (always take earliest child).
                for child, next_child in zip(children[:-1], children[1:]):
                    if active(next_child) and not active(child):
                        return False

            # Number of active observed node types matches.
            for obs_type in observed_node_types:
                n_observed = len([o for o in base_observed_nodes if o.type == obs_type])
                n_active = len([n for n in base_super_tree if n.type == obs_type and active(n)])
                if n_observed != n_active:
                    return False
            return True

        if not is_feasible(node_activations):
            #prog.AddBoundingBoxConstraint(0., 0., categorical_weights[combo_k])
            all_super_trees.append(None)
            all_observed_nodes.append(None)
            continue

        # Now we know this tree *could* create the desired output, and we don't
        # need to enforce the above constraints.
        print("Got good tree config!")
        print("Node activations: ", node_activations)

        # Create a supertree and observed not set copy for data storage.
        super_tree = deepcopy(base_super_tree)
        # Record node active/not for convenience / reference later.
        for node in super_tree:
            node.active = active(node)
        all_super_trees.append(super_tree)
        observed_nodes = deepcopy(base_observed_nodes)
        all_observed_nodes.append(observed_nodes)

        # For each node, if it's not an observed type, create a uniform distribution on its x position.
        # Otherwise, create a Delta.
        for node_k, node in enumerate(super_tree.nodes):
            if node.type in observed_node_types:
                node.x_optim = prog.NewContinuousVariables(2, "%d_%d_x_delta" % (combo_k, node_k))
                prog.AddBoundingBoxConstraint(np.zeros(2), np.ones(2), node.x_optim)
            else:
                node.x_optim_lb = prog.NewContinuousVariables(2, "%d_%d_x_lb" % (combo_k, node_k))
                node.x_optim_ub = prog.NewContinuousVariables(2, "%d_%d_x_lb" % (combo_k, node_k))
                # Finite support, please...
                for k in range(2):
                    prog.AddLinearConstraint(node.x_optim_lb[k] + 1E-6 <= node.x_optim_ub[k])
                prog.AddBoundingBoxConstraint(np.zeros(2), np.ones(2), node.x_optim_lb)
                prog.AddBoundingBoxConstraint(np.zeros(2), np.ones(2), node.x_optim_ub)
                if node.type is "root":
                    # Force to origin
                    prog.AddBoundingBoxConstraint(np.zeros(2), np.zeros(2), node.x_optim_lb)
                    prog.AddBoundingBoxConstraint(np.zeros(2), np.zeros(2), node.x_optim_ub)

        # We still aren't *guaranteed* feasibility; it's possible that there's no
        # physically valid arrangement of these nodes to match the observation. So
        # use a slack sort of arrangement to detect infeasibility.
        feasibility_indicator = prog.NewBinaryVariables(1, "%d_feas_slack" % combo_k)[0]

        #prog.AddLinearConstraint(categorical_weights[combo_k] <= feasibility_indicator)

        for parent_node in super_tree.nodes:
            children = list(super_tree.successors(parent_node))

            # The child support needs to be feasible no matter where the parent
            # is drawn in its own support.
            # TODO(gizatt) This is overly restrictive? It's like an inner approx
            # of the the support region?
            # This constraint is deactived if the feasibility indicator is off.
            if len(children) > 0:
                lb, ub = grammar[parent_node.type].bounds
            for child_node in children:
                if parent_node.type in observed_node_types:
                    raise NotImplementedError("Observed non-terminal not handled yet. Doable though?")
                if child_node.type in observed_node_types:
                    # | Child location - parent location| <= bounds.
                    M = 1. # Max position error in an axis
                    for k in range(2):
                        prog.AddLinearConstraint(
                            child_node.x_optim[k] >= parent_node.x_optim_ub[k] + lb[k]
                            - M * (1. - feasibility_indicator)
                        )
                        prog.AddLinearConstraint(
                            child_node.x_optim[k] <= parent_node.x_optim_lb[k] + ub[k]
                            + M * (1. - feasibility_indicator)
                        )
                else:
                    # Child lb and ub both need to be possible to be
                    # generated from the parent anywhere the parent can be drawn.
                    M = 1. # Max position error in an axis
                    for bound in [child_node.x_optim_lb, child_node.x_optim_ub]:
                        for k in range(2):
                            prog.AddLinearConstraint(
                                bound[k] >= parent_node.x_optim_ub[k] + lb[k]
                                - M * (1. - feasibility_indicator)
                            )
                            prog.AddLinearConstraint(
                                bound[k] <= parent_node.x_optim_lb[k] + ub[k]
                                + M * (1. - feasibility_indicator)
                            )

            # Child supports should be ordered, to break symmetries.
            for child, next_child in zip(children[:-1], children[1:]):
                if child.type in observed_node_types:
                    prog.AddLinearConstraint(next_child.x_optim[0] >= child.x_optim[0])
                else:
                    # TODO(gizatt) Upper bounds too? Worried about being too restrictive.
                    prog.AddLinearConstraint(next_child.x_optim_lb[0] >= child.x_optim_lb[0])

        # Finally, feasibility depends on existence of a legal corresponce between
        # the active observed nodes and observed nodes.
        for n in super_tree:
            # (first prep some bookkeeping)
            n.outgoings = []
        for observed_node in observed_nodes:
            possible_sources = [n for n in super_tree if n.type == observed_node.type and n.active]
            source_actives = prog.NewBinaryVariables(len(possible_sources), "%d_%s_sources" % (combo_k, observed_node.type))

            # Store these variables
            observed_node.source_actives = source_actives
            for k, n in enumerate(possible_sources):
                n.outgoings.append(source_actives[k])

            # Each observed node needs exactly one explaining input.
            # (This is relaxed is feasibility is impossible, which allows the
            # trivial solution that the observed node is unexplained and supplies no
            # constraints to the dead / zero-prob supertree.)
            prog.AddLinearEqualityConstraint(sum(source_actives) == feasibility_indicator)

            for k, node in enumerate(possible_sources):
                M = 1. # Should upper bound positional error in any single dimension
                # When correspondence is active, force the node to match the observed node.
                # Otherwise, it can vary within a big M of the observed node.
                for i in range(2):
                    prog.AddLinearConstraint(node.x_optim[i] <= observed_node.x[i] + 1E-6 + (1. - source_actives[k]) * M)
                    prog.AddLinearConstraint(node.x_optim[i] >= observed_node.x[i] - 1E-6 - (1. - source_actives[k]) * M)

        # Go back and make sure no node in the super tree is being used
        # to explain more than one observed node.
        for node in super_tree:
            if node.type in observed_node_types:
                if len(node.outgoings) > 0:
                    prog.AddLinearConstraint(sum(node.outgoings) <= 1)

        # Finally, pull out probabilities from the tree.
        # Apply a massive negative penalty if this tree arrangement is deactived,
        # since that would be an admission that P(T) = 0, and deactive the penalty
        # if not.
        M = 100.

        total_log_prob = -M * (1. - feasibility_indicator) # 0. # = categorical_weights[combo_k]
        log_prob_of_tree_structure = 0.
        # And sum of log probs of discrete and continuous choices in tree.
        for parent_node in super_tree.nodes:
            children = list(super_tree.successors(parent_node))
            # Geometric value of having this # of children.
            active_children = [c for c in children if c.active]
            if len(active_children) > 0:
                p = grammar[parent_node.type].p
                log_prob_of_tree_structure += np.log((1. - p) ** len(active_children) * p)
                for child in active_children:
                    # Density of child support region
                    if child.type in observed_node_types:
                        # Delta, no density
                        pass
                    else:
                        # TODO(gizatt) This isn't quite right -- need log() this difference...
                        # TODO Full maximum entropy derivation, gonna be rough...
                        total_log_prob += sum(child.x_optim_ub - child.x_optim_lb)

        super_tree.total_log_prob = total_log_prob
        super_tree.log_prob_of_tree_structure = log_prob_of_tree_structure
        super_tree.feasibility_indicator = feasibility_indicator
        # Maximize log prob, so min -ll.
        prog.AddLinearCost(-total_log_prob)

    solver = GurobiSolver()
    options = SolverOptions()
    logfile = "/tmp/gurobi.log"
    os.system("rm %s" % logfile)
    options.SetOption(solver.id(), "LogFile", logfile)
    if verbose:
        print("Num vars: ", prog.num_vars())
        print("Num constraints: ", sum([c.evaluator().num_constraints() for c in prog.GetAllConstraints()]))
        print("Setup time: ", time.time() - setup_start_time)
    solve_start_time = time.time()
    result = solver.Solve(prog, None, options)
    if verbose:
        print("Optimization success?: ", result.is_success())
        print("Solve time: ", time.time() - solve_start_time)
        print("Logfile: ")
        with open(logfile) as f:
            print(f.read())

    # Post-process a bit: for each feasible tree, grab the computed log-density
    # of that tree to build the categorical weights.
    categorical_weights_ll = []
    for super_tree in all_super_trees:
        if super_tree is None or not result.GetSolution(super_tree.feasibility_indicator):
            categorical_weights_ll.append(-1E10)
        else:
            ll = result.GetSolution(super_tree.log_prob_of_tree_structure).Evaluate()
            print(result.GetSolution(super_tree.feasibility_indicator), ll)
            categorical_weights_ll.append(ll)
    # Normalize in log space since some of the values will be nasty.
    categorical_weights_ll -= sp.special.logsumexp(categorical_weights_ll)
    categorical_weights = np.exp(categorical_weights_ll)
    TreeDistInferenceResults = namedtuple(
        "TreeDistInferenceResults",
        ["optim_result", "categorical_weights", "all_super_trees", "all_observed_nodes", "base_observed_nodes", "grammar", "observed_node_types"]
    )
    return TreeDistInferenceResults(
        result, categorical_weights, all_super_trees, all_observed_nodes,
        base_observed_nodes, grammar, observed_node_types
    )

observed_nodes = deepcopy(get_observed_nodes(example_tree, cluster_grammar_observed_types))
print("Starting with %d observed nodes" % len(observed_nodes))
start_time = time.time()
inference_results = infer_tree_dist_by_tree_enum(
    cluster_grammar, observed_nodes, cluster_grammar_observed_types,
    verbose=True
)
elapsed = time.time() - start_time
print("Took %f secs" % elapsed)
print("Nonzero categorical weights: ", [c for c in inference_results.categorical_weights if c > 0])
print("Sparsity: %d/%d weights are nonzero." % (
    len([c for c in inference_results.categorical_weights if c > 0]),
    len(inference_results.categorical_weights)
))
```

    Starting with 3 observed nodes
    Got good tree config!
    Node activations:  [1, 1, 0, 0, 1, 1, 1, 0, 0, 0, 0, 0, 0]
    Got good tree config!
    Node activations:  [1, 1, 1, 0, 1, 0, 0, 1, 1, 0, 0, 0, 0]
    Got good tree config!
    Node activations:  [1, 1, 1, 0, 1, 1, 0, 1, 0, 0, 0, 0, 0]
    Got good tree config!
    Node activations:  [1, 1, 1, 1, 1, 0, 0, 1, 0, 0, 1, 0, 0]
    Num vars:  176
    Num constraints:  624
    Setup time:  0.15740609169006348
    Optimization success?:  True
    Solve time:  0.037956953048706055
    Logfile:

    Gurobi 9.0.2 (linux64) logging started Thu Jul 29 22:58:33 2021

    1.0 -3.635634939595124
    1.0 -5.715076481274959
    1.0 -5.71507648127496
    1.0 -7.7945180229547955
    Took 0.221015 secs
    Nonzero categorical weights:  [0.7901234567901236, 0.09876543209876551, 0.09876543209876543, 0.012345679012345685]
    Sparsity: 4/8192 weights are nonzero.

```python
# Draw all ways of explaining the given scene, with support boxes for each node type.
# Sample trees from the results:
from matplotlib.patches import Rectangle
def draw_all_explanations(inference_results, width=None, draw_as_supertree=False):
    nonzero_weights_and_combos = [(k, w) for k, w in enumerate(inference_results.categorical_weights) if w > 1E-4]
    if width:
        height = len(nonzero_weights_and_combos) // width
        plt.figure().set_size_inches(5*width, 5*height)
    for k, (combo_k, weight) in enumerate(nonzero_weights_and_combos):
        if width:
            plt.subplot(width, height, k+1)
        else:
            plt.figure().set_size_inches(5, 5)

        # Grab that supertree from optimization
        optim_result = inference_results.optim_result
        super_tree = inference_results.all_super_trees[combo_k]
        assert optim_result.GetSolution(super_tree.feasibility_indicator)
        observed_nodes = inference_results.all_observed_nodes[combo_k]
        observed_node_types = inference_results.observed_node_types

        # Sanity-check observed nodes are explained properly.
        for observed_node in observed_nodes:
            if not np.isclose(np.sum(optim_result.GetSolution(observed_node.source_actives)), 1.):
                print("WARN: observed node at %s not explained by MLE sol." % observed_node.x)

        illustration_tree = nx.DiGraph()
        colors_by_type = {}
        node_colors = {}
        for node in super_tree:
            if node.active:
                illustration_tree.add_node(node)
                color = plt.get_cmap("jet")(np.random.random())
                node_colors[node] = color
                # Put node xy at center of support region
                # and draw support regions
                if node.type in observed_node_types:
                    # Node xy distribution is delta -> copy it over
                    node.x = optim_result.GetSolution(node.x_optim)
                else:
                    # Node xy distribution is Uniform -> sample
                    lb = optim_result.GetSolution(node.x_optim_lb)
                    ub = optim_result.GetSolution(node.x_optim_ub)
                    node.x = (lb + ub) / 2.
                    if not draw_as_supertree:
                        plt.gca().add_patch(
                            Rectangle(lb, ub[0]-lb[0], ub[1]-lb[1],
                                     color=color,
                                     alpha=0.5))
                parents = list(super_tree.predecessors(node))
                assert len(parents) <= 1
                if len(parents) == 1:
                    parent = parents[0]
                    assert parent.active
                    illustration_tree.add_edge(parent, node)
        # Draw
        if draw_as_supertree:
            draw_tree(illustration_tree, alpha=0.9, ax=plt.gca(), draw_pos=False)
            plt.gca().set_xlim(-2, 2)
            plt.gca().set_ylim(-2, 2)
        else:
            draw_tree(illustration_tree, alpha=0.5, ax=plt.gca(), node_size=50)
        binary_string = format(combo_k, '#0%db' % (len(super_tree.nodes)+2))[2:]
        plt.title("Combo %0s, weight %f" % (binary_string, weight))

draw_all_explanations(inference_results, draw_as_supertree=True, width=2)
```

```python
# Sample trees from the results:
def sample_tree_from_results(inference_results):
    # Pick which tree structure
    weights = inference_results.categorical_weights
    combo_k = np.random.choice(len(weights),p=weights)

    # Grab that supertree from optimization
    optim_result = inference_results.optim_result
    super_tree = inference_results.all_super_trees[combo_k]
    assert optim_result.GetSolution(super_tree.feasibility_indicator)
    observed_nodes = inference_results.all_observed_nodes[combo_k]
    observed_node_types = inference_results.observed_node_types

    # Sanity-check observed nodes are explained properly.
    for observed_node in observed_nodes:
        if not np.isclose(np.sum(optim_result.GetSolution(observed_node.source_actives)), 1.):
            print("WARN: observed node at %s not explained by MLE sol." % observed_node.x)

    sampled_tree = nx.DiGraph()
    super_tree = deepcopy(super_tree)
    for node in super_tree:
        if node.active:
            sampled_tree.add_node(node)
            # Sample node xy
            if node.type in observed_node_types:
                # Node xy distribution is delta -> copy it over
                node.x = optim_result.GetSolution(node.x_optim)
            else:
                # Node xy distribution is Uniform -> sample
                lb = optim_result.GetSolution(node.x_optim_lb)
                ub = optim_result.GetSolution(node.x_optim_ub)
                node.x = np.random.uniform(lb, ub)
            parents = list(super_tree.predecessors(node))
            assert len(parents) <= 1
            if len(parents) == 1:
                parent = parents[0]
                assert parent.active
                sampled_tree.add_edge(parent, node)
    return sampled_tree, weights[combo_k]

width = 3
height = 3
plt.figure().set_size_inches(5*width, 5*height)
for k in range(width*height):
    plt.subplot(width, height, k+1)
    sampled_tree, weight = sample_tree_from_results(inference_results)
    draw_tree(sampled_tree, alpha=0.75, ax=plt.gca())
    plt.title("Combo weight %f" % weight)
```

```python
# Plot intermediate node density as a heatmap, overlaid on
from scipy.stats.kde import gaussian_kde

def draw_intermediate_node_heatmaps(inference_results, n_samples=1000):
    grammar = inference_results.grammar
    observed_node_types = inference_results.observed_node_types
    non_root_non_observed_types = [type for type in grammar.keys() if type not in observed_node_types and type is not "root"]
    # Sample a bunch of trees
    trees = [sample_tree_from_results(inference_results) for k in range(n_samples)]
    # Pick out nodes of each type
    by_type = {type: [] for type in non_root_non_observed_types}
    for tree, weight in trees:
        for type in by_type.keys():
            by_type[type] += [(n, weight) for n in tree.nodes if n.type == type]
    plt.figure().set_size_inches(10, 10)
    for k, type in enumerate(by_type.keys()):
        ax = plt.subplot(1, len(non_root_non_observed_types), k+1)
        x = [n.x[0] for n, _ in by_type[type]]
        y = [n.x[1] for n, _ in by_type[type]]
        weights = [w for _, w in by_type[type]]

        #k = gaussian_kde(np.vstack([x, y]), weights=weights)
        #xi, yi = np.mgrid[0:1:0.01,0:1:0.01]
        #zi = k(np.vstack([xi.flatten(), yi.flatten()]))
        #plt.gca().pcolormesh(xi, yi, zi.reshape(xi.shape), alpha=0.75, cmap=plt.get_cmap("GnBu"))
        #plt.gca().contourf(xi, yi, zi.reshape(xi.shape), alpha=1.0, cmap=plt.get_cmap("GnBu"))
        plt.scatter(x, y, alpha=0.1)

        draw_observed_nodes(inference_results.base_observed_nodes)
        plt.title("Intermediate %s positions over %d samples" % (type, n_samples))
        plt.gca().add_patch(Rectangle([0, 0], 1, 1, facecolor='none'))
draw_intermediate_node_heatmaps(inference_results, n_samples=1000)
```

```python
# Try to sample scenes with matching observation
sampled_scenes = []
EPS = 0.1
our_x = np.stack([n.x for n in observed_nodes], axis=0)
print(our_x)
print(our_x.shape)
for k in range(1000000):
    if k % 25000 == 0:
        print(k)
    guess_tree = sample_tree(cluster_grammar)
    guess_observed_nodes = deepcopy(get_observed_nodes(guess_tree, cluster_grammar_observed_types))
    if len(guess_observed_nodes) == len(observed_nodes):
        good = True
        for n in guess_observed_nodes:
            if np.min(np.sum(np.abs(our_x - n.x), axis=-1)) >= EPS:
                good = False
                break
        if good:
            sampled_scenes.append(guess_tree)
print("Got %d scenes" % len(sampled_scenes))
```

    [[0.85914708 0.47844389]
     [0.66839946 0.29186599]
     [0.57532687 0.46299854]]
    (3, 2)
    0
    25000
    50000
    75000
    100000
    125000
    150000
    175000
    200000
    225000
    250000
    275000
    300000
    325000
    350000
    375000
    400000
    425000
    450000
    475000
    500000
    525000
    550000
    575000
    600000
    625000
    650000
    675000
    700000
    725000
    750000
    775000
    800000
    825000
    850000
    875000
    900000
    925000
    950000
    975000
    Got 1666 scenes

```python
# Plot intermediate node density as a heatmap, overlaid on
from scipy.stats.kde import gaussian_kde

def draw_intermediate_node_heatmaps_for_sampled_scenes(trees, grammar, observed_node_types):
    # Pick out nodes of each type
    non_root_non_observed_types = [type for type in grammar.keys() if type not in observed_node_types and type is not "root"]
    by_type = {type: [] for type in non_root_non_observed_types}
    for tree in trees:
        for type in by_type.keys():
            by_type[type] += [n for n in tree.nodes if n.type == type]
    plt.figure().set_size_inches(10, 10)
    for k, type in enumerate(by_type.keys()):
        ax = plt.subplot(1, len(non_root_non_observed_types), k+1)
        x = [n.x[0] for n in by_type[type]]
        y = [n.x[1] for n in by_type[type]]

        #k = gaussian_kde(np.vstack([x, y]), weights=weights)
        #xi, yi = np.mgrid[0:1:0.01,0:1:0.01]
        #zi = k(np.vstack([xi.flatten(), yi.flatten()]))
        #plt.gca().pcolormesh(xi, yi, zi.reshape(xi.shape), alpha=0.75, cmap=plt.get_cmap("GnBu"))
        #plt.gca().contourf(xi, yi, zi.reshape(xi.shape), alpha=1.0, cmap=plt.get_cmap("GnBu"))
        plt.scatter(x, y, alpha=0.1)

        draw_observed_nodes(inference_results.base_observed_nodes)
        plt.title("Intermediate %s positions over %d samples" % (type, len(trees)))
        plt.gca().add_patch(Rectangle([0, 0], 1, 1, facecolor='none'))
draw_intermediate_node_heatmaps_for_sampled_scenes(sampled_scenes, cluster_grammar, cluster_grammar_observed_types)
```