R/feature_contri_prop.R

In tohweizhong/auxml: Auxiliary Functions for Machine Learning

feature_contrib_prop <- function(mod, target, test_case, plot = TRUE){
    
    sm <- summary(mod)
    betas <- sm$coefficients[,1]
    
    pred <- predict(mod, test_case)
    
    # feature vector
    feat_vec <- test_case[-which(test_case %>% names == target)] %>% as.matrix
    
    betas2 <- betas[-1] # less intercept
    
    # feature contributions
    feat_cont <- betas2*feat_vec
    feat_cont <- c(betas[1], feat_cont, pred)
    names(feat_cont) <- c(nm, "Prediction")
    
    # contribution proportions
    cont_prop <- feat_cont/pred
    
    # barplot on contribution proportions
    plot_data <- data.frame(coef = names(cont_prop),
                            cont_prop = cont_prop,
                            row.names = NULL)
    plot_data <- plot_data[order(plot_data$cont_prop, decreasing = FALSE),]
    plot_data$coef <- factor(plot_data$coef, levels = plot_data$coef)
    
    gg <- ggplot(data = plot_data, aes(x = coef, y = cont_prop)) +
        geom_bar(stat = "identity", fill = "darkblue") +
        theme_minimal() +
        ylab("Contribution Proportions") +
        xlab("Features") +
        ggtitle("Feature Contribution Proportions") +
        coord_flip()
    
        print(gg)
    
    return(cont_prop)
}