Site icon R-bloggers

Building models with {shiny} and {tidyAML} Part 2

Steven P. Sanderson II, MPH
[This article was first published on Steve's Data Tips and Tricks, and kindly contributed to R-bloggers]. (You can report issue about the content on this page here)
Want to share your content on R-bloggers? click here if you have a blog, or here if you don't.
< section id="introduction" class="level1">

Introduction

Yesterday I spoke about building tidymodels models using my package {tidyAML} and {shiny}. I have made an update to it, and will continue to make updates to it this week.

I have added all of the supported engines for regression problems only, NOT classification yet, that will be tomorrow’s work. I will then add a drop down for users to pick which backend function they want to use from {parsnp} like linear_reg().

Here are some pictures of the udpates.

New Drop Down Additions

reactable Error, not sure on how to fix yet

reactable output

Here is the full application, please steal this code and modify for yourself, you never know what you might come up with!

library(shiny)
library(tidyAML)
library(recipes)
library(DT)
library(glmnet)
library(tidymodels)
library(reactable)

tidymodels_prefer()

ui <- fluidPage(
  titlePanel("TidyAML Model Builder"),
  sidebarLayout(
    sidebarPanel(
      fileInput("file", "Upload your data file (csv or txt):"),
      selectInput("dataset", 
                  "Choose a built-in dataset:", 
                  choices = c("mtcars", "iris")
                  ),
      selectInput("predictor_col", 
                  "Select the predictor column:", 
                  choices = NULL
                  ),
      selectInput("model_type", 
                  "Select a model type:", 
                  choices = c("regression", "classification")),
      selectInput("model_fn", "Select a model function:", 
                  choices = c("all","lm","brulee","gee","glm",
                              "glmer","glmnet","gls","lme",
                              "lmer","stan","stan_glmer",
                              "Cubist","hurdle","zeroinfl","earth",
                              "rpart","dbarts","xgboost","lightgbm",
                              "partykit","mgcv","nnet","kknn","ranger",
                              "randomForest","xrf","LiblineaR","kernlab"
                            )
                  ),
      actionButton("build_model", "Build Model"),
      verbatimTextOutput("recipe_output")
    ),
    mainPanel(
      verbatimTextOutput("model_table"),
      reactableOutput("model_reactable")
    )
  )
)

server <- function(input, output, session) {
  
  data <- reactive({
    if (!is.null(input$file)) {
      df <- read.csv(
        input$file$datapath, 
        header = TRUE, 
        stringsAsFactors = FALSE
        )
      updateSelectInput(
        session, 
        "predictor_col", 
        choices = names(df)
        )
      return(df)
    } else if (!is.null(input$dataset)) {
      df <- get(input$dataset)
      updateSelectInput(
        session, 
        "predictor_col", 
        choices = names(df)
        )
      return(df)
    }
  })
  
  recipe_obj <- eventReactive(input$predictor_col, {
    rec <- recipe(as.formula(paste(input$predictor_col, "~ .")), 
                  data = data()
                  ) |>
      step_normalize(all_numeric(), -all_outcomes())
    return(rec)
  })
  
  model_fn <- reactive({
    switch(input$model_fn,
           "all" = "all",
           "lm" = "lm",
           "brulee" = "brulee",
           "gee" = "gee",
           "glm" = "glm",
           "glmer" = "glmer",
           "glmnet" = "glmnet",
           "gls" = "gls",
           "lme" = "lme",
           "lmer" = "lmer",
           "stan" = "stan",
           "stan_glmer" = "stan_glmer",
           "Cubist" = "Cubist",
           "hurdle" = "hurdle",
           "zeroinfl" = "zeroinfl",
           "earth" = "earth",
           "rpart" = "rpart",
           "dbarts" = "dbarts",
           "xgboost" = "xgboost"          ,
           "lightgbm" = "lightgbm",
           "partykit" = "partykit",
           "mgcv" = "mgcv",
           "nnet" = "nnet",
           "kknn" = "kknn",
           "ranger" = "ranger",
           "randomForest" = "randomForest",
           "xrf" = "xrf",
           "LiblineaR" = "LiblineaR",
           "kernlab = kernlab")
  })
  
  model <- eventReactive(input$build_model, {
    if (input$model_type == "regression") {
      mod <- fast_regression(.data = data(),
                             .rec_obj = recipe_obj(),
                             .parsnip_eng = model_fn())
    } else if (input$model_type == "classification") {
      mod <- fast_classification(.data = data(),
                                 .rec_obj = recipe_obj(),
                                 .parsnip_eng = model_fn())
    }
    return(mod)
  })
  
  output$recipe_output <- renderPrint({
    if (!is.null(input$predictor_col)) {
      summary(recipe_obj())
    }
  })
  
  output$model_table <- renderPrint({
    if (input$build_model > 0) {
      print(model())
    }
  })
  
  output$model_reactable <- renderReactable({
    if (input$build_model > 0) {
      reactable(model())
    }
  })
  
}

shinyApp(ui = ui, server = server)
To leave a comment for the author, please follow the link and comment on their blog: Steve's Data Tips and Tricks.
R-bloggers.com offers daily e-mail updates about R news and tutorials about learning R and many other topics. Click here if you're looking to post or find an R/data-science job.
Want to share your content on R-bloggers? click here if you have a blog, or here if you don't.
Exit mobile version