Hello all,
We have a very (very) simple app that allows to load a csv file, choose a targeted variable, and apply a model to predict new values, . The app works fine in our local machines. We wanted to upload it to shinyapps to share it with remote colleagues, however, the app doesn't work anymore and we are constantly disconnected from the server.
Reading the logs, it seems there is a problem with the model and predict function. But locally, there were no errors. The .RDS file is in the root directory.
We are far from specialists in R but only users... if someone can help us, we'll be very grateful !
Thanks in advance.
Here is the logs, and below the Rcode:
2024-02-25T07:05:49.320865+00:00 shinyapps[11319459]: Listening on http://127.0.0.1:44583
2024-02-25T07:07:43.281916+00:00 shinyapps[11319459]:summarise()has grouped output by 'Week'. You can override using the
2024-02-25T07:07:43.287192+00:00 shinyapps[11319459]:.groupsargument.
2024-02-25T07:07:43.292452+00:00 shinyapps[11319459]: Warning: Error in UseMethod: no applicable method for 'predict' applied to an object of class "xgb.Booster"
2024-02-25T07:07:43.296985+00:00 shinyapps[11319459]: 15:
2024-02-25T07:07:43.301533+00:00 shinyapps[11319459]: 13: fn
2024-02-25T07:07:43.306082+00:00 shinyapps[11319459]: 8: retry
2024-02-25T07:07:43.310696+00:00 shinyapps[11319459]: 7: connect$retryingStartServer
2024-02-25T07:07:43.315218+00:00 shinyapps[11319459]: 6: eval
2024-02-25T07:07:43.319612+00:00 shinyapps[11319459]: 5: eval
2024-02-25T07:07:43.324319+00:00 shinyapps[11319459]: 4: eval
2024-02-25T07:07:43.328788+00:00 shinyapps[11319459]: 3: eval
2024-02-25T07:07:43.333339+00:00 shinyapps[11319459]: 2: eval.parent
2024-02-25T07:07:43.338092+00:00 shinyapps[11319459]: 1: local
library(shiny)
library(dplyr)
library(ggplot2)
library(lubridate)
# Load the model
model <- readRDS("model.RDS")
# Define UI
ui <- fluidPage(
titlePanel("Predictive Analysis App"),
sidebarLayout(
sidebarPanel(
fileInput("file", "Charger un CSV (sep=; dec=,)"),
selectInput("datetime_column", "Selectionner la colonne Date/Heure", choices = NULL),
selectInput("target_column", "Selectionner la colonne WTD (en m)", choices = NULL),
numericInput("delta_value", "Entrez une valeur de delta (%)", value = 0),
actionButton("calculate_button", "Calculer")
),
mainPanel(
plotOutput("plot"),
tableOutput("table")
)
)
)
# Define server
server <- function(input, output, session) {
data <- reactive({
req(input$file)
read.csv(input$file$datapath, sep = ";", dec = ",", na.strings = c("", "-9999"),stringsAsFactors = FALSE,encoding='UTF-8')
})
observe({
req(data())
updateSelectInput(session, "datetime_column", choices = names(data()))
updateSelectInput(session, "target_column", choices = names(data()))
})
observeEvent(input$calculate_button, {
req(data(), input$delta_value, input$datetime_column, input$target_column)
model <- readRDS("model.RDS")
# Calculate the updated target variable with the delta value applied
data_parsed <- data()
data_parsed$DateTime <- as.POSIXct(data_parsed[[input$datetime_column]], format = "%d/%m/%Y %H:%M")
data_parsed$Updated_Target <- data_parsed[[input$target_column]] * (1 + input$delta_value / 100)
# Calculate summary statistics for the original and updated target variables
summary_df <- data_parsed %>%
mutate(Week = lubridate::week(DateTime), year = lubridate::year(DateTime)) %>%
group_by(Week, year) %>%
summarise(
Mean_WTD = mean(!!sym(input$target_column), na.rm = TRUE),
SD_WTD = sd(!!sym(input$target_column), na.rm = TRUE),
Min_WTD = min(!!sym(input$target_column), na.rm = TRUE),
Max_WTD = max(!!sym(input$target_column), na.rm = TRUE),
Mean_Updated_WTD = mean(Updated_Target, na.rm = TRUE),
SD_Updated_WTD = sd(Updated_Target, na.rm = TRUE),
Min_Updated_WTD = min(Updated_Target, na.rm = TRUE),
Max_Updated_WTD = max(Updated_Target, na.rm = TRUE)
) %>%
ungroup()
# Select only the necessary features for the model
desired_order <- c("Mean_WTD", "Max_WTD", "Min_WTD", "SD_WTD", "Week")
features_df <- summary_df[, desired_order]
# Predictions using the model
original_predictions <- predict(model, as.matrix(features_df))
# Update features_df for updated target variable
features_df[, c("Mean_WTD", "Max_WTD", "Min_WTD", "SD_WTD")] <- summary_df[, c("Mean_Updated_WTD", "Max_Updated_WTD", "Min_Updated_WTD", "SD_Updated_WTD")]
updated_predictions <- predict(model, as.matrix(features_df))
# Add predicted values to the summary dataframe
summary_df$Predicted_NEE <- original_predictions
summary_df$Predicted_Updated_NEE <- updated_predictions
# Calculate cumulative predicted NEE by year for both original and updated target variables
summary_df <- summary_df %>%
group_by(year) %>%
mutate(
Cumulative_Predicted_NEE = cumsum(Predicted_NEE),
Cumulative_Predicted_Updated_NEE = cumsum(Predicted_Updated_NEE)
) %>%
ungroup()
output$plot <- renderPlot({
# Plotting cumulative NEE values by year for both original and updated target variables
ggplot(summary_df, aes(x = Week)) +
geom_line(aes(y = Cumulative_Predicted_NEE, color = "Original")) +
geom_line(aes(y = Cumulative_Predicted_Updated_NEE, color = "Updated")) +
labs(x = "Week", y = "Cumulative Predicted NEE", color = "Variable") +
facet_wrap(~year) +
theme_minimal()
})
# Creating summary table
last_values_table <- summary_df %>%
group_by(year) %>%
summarise(
Last_Cumulative_Predicted_NEE = last(Cumulative_Predicted_NEE),
Last_Cumulative_Predicted_Updated_NEE = last(Cumulative_Predicted_Updated_NEE)
)
output$table <- renderTable({
last_values_table
})
})
}
# Run
shinyApp(ui = ui, server = server)