From a1f58628b7f3fbd22d18c4d1634a05b667d26ce7 Mon Sep 17 00:00:00 2001 From: Nate Date: Thu, 29 Jan 2026 18:13:26 -0500 Subject: [PATCH 1/2] Refactor input handling and fix prediction bug Fixed bug related to non-numeric argument in prediction process by ensuring correct data types for input variables. Refactored the datasetInput reactive expression for better clarity and efficiency. --- shiny/003-play-golf/app.R | 119 +++++++++++++++++++------------------- 1 file changed, 60 insertions(+), 59 deletions(-) diff --git a/shiny/003-play-golf/app.R b/shiny/003-play-golf/app.R index 3715ade..fc04ec0 100644 --- a/shiny/003-play-golf/app.R +++ b/shiny/003-play-golf/app.R @@ -12,8 +12,18 @@ library(data.table) library(RCurl) library(randomForest) -# Read data -weather <- read.csv(text = getURL("https://raw.githubusercontent.com/dataprofessor/data/master/weather-weka.csv") ) +# Read data, at first I got an error message stating, +# Error in y - ymean : non-numeric argument to binary operator +# Until I put in line 20 and lines 23-25. Fixed bug. +weather <- read.csv( + text = getURL("https://raw.githubusercontent.com/dataprofessor/data/master/weather-weka.csv"), + stringsAsFactors = FALSE +) + +weather$play <- as.factor(weather$play) +weather$outlook <- as.factor(weather$outlook) +weather$windy <- as.factor(weather$windy) + # Build model model <- randomForest(play ~ ., data = weather, ntree = 500, mtry = 4, importance = TRUE) @@ -29,36 +39,36 @@ model <- randomForest(play ~ ., data = weather, ntree = 500, mtry = 4, importanc #################################### ui <- fluidPage(theme = shinytheme("united"), - - # Page header - headerPanel('Play Golf?'), - - # Input values - sidebarPanel( - HTML("

Input parameters

"), - - selectInput("outlook", label = "Outlook:", - choices = list("Sunny" = "sunny", "Overcast" = "overcast", "Rainy" = "rainy"), - selected = "Rainy"), - sliderInput("temperature", "Temperature:", - min = 64, max = 86, - value = 70), - sliderInput("humidity", "Humidity:", - min = 65, max = 96, - value = 90), - selectInput("windy", label = "Windy:", - choices = list("Yes" = "TRUE", "No" = "FALSE"), - selected = "TRUE"), - - actionButton("submitbutton", "Submit", class = "btn btn-primary") - ), - - mainPanel( - tags$label(h3('Status/Output')), # Status/Output Text Box - verbatimTextOutput('contents'), - tableOutput('tabledata') # Prediction results table - - ) + + # Page header + headerPanel('Play Golf?'), + + # Input values + sidebarPanel( + HTML("

Input parameters

"), + + selectInput("outlook", label = "Outlook:", + choices = list("Sunny" = "sunny", "Overcast" = "overcast", "Rainy" = "rainy"), + selected = "Rainy"), + sliderInput("temperature", "Temperature:", + min = 64, max = 86, + value = 70), + sliderInput("humidity", "Humidity:", + min = 65, max = 96, + value = 90), + selectInput("windy", label = "Windy:", + choices = list("Yes" = "TRUE", "No" = "FALSE"), + selected = "TRUE"), + + actionButton("submitbutton", "Submit", class = "btn btn-primary") + ), + + mainPanel( + tags$label(h3('Status/Output')), # Status/Output Text Box + verbatimTextOutput('contents'), + tableOutput('tabledata') # Prediction results table + + ) ) #################################### @@ -66,35 +76,26 @@ ui <- fluidPage(theme = shinytheme("united"), #################################### server <- function(input, output, session) { - + + + # Refactored the 'datasetInput' reactive expression # Input Data datasetInput <- reactive({ - # outlook,temperature,humidity,windy,play - df <- data.frame( - Name = c("outlook", - "temperature", - "humidity", - "windy"), - Value = as.character(c(input$outlook, - input$temperature, - input$humidity, - input$windy)), - stringsAsFactors = FALSE) - - play <- "play" - df <- rbind(df, play) - input <- transpose(df) - write.table(input,"input.csv", sep=",", quote = FALSE, row.names = FALSE, col.names = FALSE) - - test <- read.csv(paste("input", ".csv", sep=""), header = TRUE) - - test$outlook <- factor(test$outlook, levels = c("overcast", "rainy", "sunny")) - - - Output <- data.frame(Prediction=predict(model,test), round(predict(model,test,type="prob"), 3)) - print(Output) - + # Create the dataframe with correct types immediately + test <- data.frame( + outlook = factor(input$outlook, levels = levels(weather$outlook)), + temperature = as.numeric(input$temperature), + humidity = as.numeric(input$humidity), + windy = factor(input$windy, levels = levels(weather$windy)) + ) + + # Generate prediction + Output <- data.frame( + Prediction = predict(model, test), + round(predict(model, test, type = "prob"), 3) + ) + print(Output) }) # Status/Output Text Box @@ -118,4 +119,4 @@ server <- function(input, output, session) { #################################### # Create the shiny app # #################################### -shinyApp(ui = ui, server = server) +shinyApp(ui = ui, server = server) ` From ebcc417d7981b8f23cdd06d8dfa24861e23b8594 Mon Sep 17 00:00:00 2001 From: Nate Date: Thu, 29 Jan 2026 18:21:37 -0500 Subject: [PATCH 2/2] Refactor UI layout in app.R for clarity --- shiny/003-play-golf/app.R | 48 +++++++++++++++++++-------------------- 1 file changed, 24 insertions(+), 24 deletions(-) diff --git a/shiny/003-play-golf/app.R b/shiny/003-play-golf/app.R index fc04ec0..65f9d70 100644 --- a/shiny/003-play-golf/app.R +++ b/shiny/003-play-golf/app.R @@ -40,35 +40,35 @@ model <- randomForest(play ~ ., data = weather, ntree = 500, mtry = 4, importanc ui <- fluidPage(theme = shinytheme("united"), - # Page header - headerPanel('Play Golf?'), + # Page header + headerPanel('Play Golf?'), - # Input values - sidebarPanel( - HTML("

Input parameters

"), + # Input values + sidebarPanel( + HTML("

Input parameters

"), - selectInput("outlook", label = "Outlook:", - choices = list("Sunny" = "sunny", "Overcast" = "overcast", "Rainy" = "rainy"), - selected = "Rainy"), - sliderInput("temperature", "Temperature:", - min = 64, max = 86, - value = 70), - sliderInput("humidity", "Humidity:", - min = 65, max = 96, - value = 90), - selectInput("windy", label = "Windy:", - choices = list("Yes" = "TRUE", "No" = "FALSE"), - selected = "TRUE"), + selectInput("outlook", label = "Outlook:", + choices = list("Sunny" = "sunny", "Overcast" = "overcast", "Rainy" = "rainy"), + selected = "Rainy"), + sliderInput("temperature", "Temperature:", + min = 64, max = 86, + value = 70), + sliderInput("humidity", "Humidity:", + min = 65, max = 96, + value = 90), + selectInput("windy", label = "Windy:", + choices = list("Yes" = "TRUE", "No" = "FALSE"), + selected = "TRUE"), - actionButton("submitbutton", "Submit", class = "btn btn-primary") - ), + actionButton("submitbutton", "Submit", class = "btn btn-primary") + ), - mainPanel( - tags$label(h3('Status/Output')), # Status/Output Text Box - verbatimTextOutput('contents'), - tableOutput('tabledata') # Prediction results table + mainPanel( + tags$label(h3('Status/Output')), # Status/Output Text Box + verbatimTextOutput('contents'), + tableOutput('tabledata') # Prediction results table - ) + ) ) ####################################