R/feature_contri.R

In tohweizhong/auxml: Auxiliary Functions for Machine Learning

feature_contrib <- 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")
    
    # barplot on contribution proportions
    plot_data <- data.frame(coef = names(feat_cont),
                            feat_cont = feat_cont,
                            row.names = NULL)
    plot_data <- plot_data[order(plot_data$feat_cont, decreasing = FALSE),]
    plot_data$coef <- factor(plot_data$coef, levels = plot_data$coef)
    
    gg <- ggplot(data = plot_data, aes(x = coef, y = feat_cont)) +
        geom_bar(stat = "identity", fill = "darkblue") +
        theme_minimal() +
        ylab("Contributions") +
        xlab("Features") +
        ggtitle("Feature Contributions") +
        coord_flip()
    
    print(gg)
    
    return(feat_cont)
}