Deploy Random Forest Iris (Shiny)

Deploy Random Forest Iris (Shiny)

Package

library(shiny)
library(dplyr)

## 
## Attaching package: 'dplyr'

## The following objects are masked from 'package:stats':
## 
##     filter, lag

## The following objects are masked from 'package:base':
## 
##     intersect, setdiff, setequal, union

library(tidymodels)

## ── Attaching packages ────────────────────────────────────── tidymodels 1.4.1 ──

## ✔ broom        1.0.10     ✔ rsample      1.3.1 
## ✔ dials        1.4.2      ✔ tailor       0.1.0 
## ✔ ggplot2      4.0.0      ✔ tidyr        1.3.1 
## ✔ infer        1.0.9      ✔ tune         2.0.1 
## ✔ modeldata    1.5.1      ✔ workflows    1.3.0 
## ✔ parsnip      1.3.3      ✔ workflowsets 1.1.1 
## ✔ purrr        1.1.0      ✔ yardstick    1.3.2 
## ✔ recipes      1.3.1

## ── Conflicts ───────────────────────────────────────── tidymodels_conflicts() ──
## ✖ purrr::discard() masks scales::discard()
## ✖ dplyr::filter()  masks stats::filter()
## ✖ dplyr::lag()     masks stats::lag()
## ✖ infer::observe() masks shiny::observe()
## ✖ recipes::step()  masks stats::step()

library(DT)

## 
## Attaching package: 'DT'

## The following objects are masked from 'package:shiny':
## 
##     dataTableOutput, renderDataTable

DATA & TRAIN MODEL

data(iris)
set.seed(17)

Split Data

split  <- initial_split(iris, prop = 0.8, strata = Species)
train  <- training(split)
test   <- testing(split)

Recipe preprocessing

rec <- recipe(Species ~ ., data = train) %>%
  step_normalize(all_numeric_predictors())

Model Random Forest (ranger)

rf_spec <- rand_forest(trees = 500, min_n = 5) %>%
  set_engine("ranger") %>%
  set_mode("classification")

Workflow = recipe + model

wf <- workflow() %>%
  add_model(rf_spec) %>%
  add_recipe(rec)

rf_model <- fit(wf, train)

Simpan workflow

saveRDS(rf_model, file = "rf_iris_workflow.rds")

CONFUSION MATRIX + ACCURACY

pred_test <- predict(rf_model, test, type = "class")
res <- bind_cols(test, pred_test)

conf_matrix <- conf_mat(res, truth = Species, estimate = .pred_class)
acc <- accuracy(res, truth = Species, estimate = .pred_class)

conf_matrix

##             Truth
## Prediction   setosa versicolor virginica
##   setosa         10          0         0
##   versicolor      0         10         0
##   virginica       0          0        10

acc

## # A tibble: 1 × 3
##   .metric  .estimator .estimate
##   <chr>    <chr>          <dbl>
## 1 accuracy multiclass         1

Shiny App

UI

rf_wf <- readRDS("rf_iris_workflow.rds")

# Fungsi median aman
med_val <- function(x) median(x, na.rm = TRUE)

ui <- fluidPage(
titlePanel("Iris Species Prediction (Random Forest)"),
tags$small("Model dilatih dari dataset iris bawaan R."),
br(),

tabsetPanel(
# TAB 1: APLIKASI
tabPanel("Aplikasi",
  tabsetPanel(
    # SINGLE PREDICTION
    tabPanel("Single Prediction",
      sidebarLayout(
        sidebarPanel(
          numericInput("sl", "Sepal Length", value = med_val(iris$Sepal.Length)),
          numericInput("sw", "Sepal Width",  value = med_val(iris$Sepal.Width)),
          numericInput("pl", "Petal Length", value = med_val(iris$Petal.Length)),
          numericInput("pw", "Petal Width",  value = med_val(iris$Petal.Width)),
          actionButton("predict_one", "Prediksi")
        ),
        mainPanel(
          h4("Hasil Prediksi"),
          verbatimTextOutput("single_pred"),
          DTOutput("single_proba")
        )
      )
    ),

    # BATCH PREDICTION
    tabPanel("Batch Prediction",
      fileInput("csv_file", "Upload CSV tanpa kolom Species", accept = ".csv"),
      DTOutput("batch_table"),
      br(),
      downloadButton("download_preds", "Download Hasil Prediksi")
    )
  )
),


# TAB 2: MODEL PERFORMANCE
tabPanel("Model Performance",
  h4("Confusion Matrix"),
  verbatimTextOutput("conf_mat_print"),
  h4("Accuracy"),
  verbatimTextOutput("acc_print")
)

)
)

Server

server <- function(input, output, session) {

# SINGLE PREDICTION

observeEvent(input$predict_one, {
newdat <- tibble(
  Sepal.Length = input$sl,
  Sepal.Width  = input$sw,
  Petal.Length = input$pl,
  Petal.Width  = input$pw
)

cls <- predict(rf_wf, new_data = newdat, type = "class")
prb <- predict(rf_wf, new_data = newdat, type = "prob")

output$single_pred <- renderText({
  paste("Prediksi species:", cls$.pred_class)
})

output$single_proba <- renderDT({
  datatable(prb, options = list(dom = "t"))
})

})

# BATCH PREDICTION

batch_data <- reactive({
req(input$csv_file)
df <- readr::read_csv(input$csv_file$datapath, show_col_types = FALSE)
validate(
  need(all(c("Sepal.Length","Sepal.Width","Petal.Length","Petal.Width") %in% names(df)),
       "Kolom harus lengkap: Sepal.Length, Sepal.Width, Petal.Length, Petal.Width")
)
df

})

preds_df <- reactive({
df <- batch_data()
cls <- predict(rf_wf, new_data = df, type = "class")
prb <- predict(rf_wf, new_data = df, type = "prob")
bind_cols(df, tibble(Predicted = cls$.pred_class), prb)
})

output$batch_table <- renderDT({
datatable(preds_df(), options = list(pageLength = 10))
})

output$download_preds <- downloadHandler(
filename = function() "iris_predictions.csv",
content = function(file) {
readr::write_csv(preds_df(), file)
}
)

# Confusion Matrix + Accuracy

output$conf_mat_print <- renderPrint(conf_matrix)
output$acc_print <- renderPrint(acc)
}

shinyApp(ui, server)

Shiny applications not supported in static R Markdown documents