P-Tech/ReinforcementLearning
1
1library(shiny)2library(shinyjs)3library(bslib)4library(dplyr)5library(ggplot2)6library(tm)7library(SnowballC)8library(plotly)9library(text2vec)10library(tokenizers)11library(dplyr)12library(tidyr)13library(igraph)14library(ggraph)15library(topicmodels)16library(wordcloud)17library(wordcloud2)18library(reshape2)19library(SnowballC)20library(RColorBrewer)21library(syuzhet)22library(cluster)23library(tidytext)24library(word2vec)25library(Rtsne)26library(umap)27library(MASS)28library(koRpus)29library(openxlsx)30library(tools)31library(shinyWidgets)32library(reticulate)33library(keras)34library(tensorflow)35library(neuralnet)36library(rsample)37library(tfdatasets)38library(statnet)39library(UserNetR)40library(visNetwork)41library(networkD3)42library(ergm)43library(ergm.count)44library(network)45library(tidyverse)46options(width = 150)47options(digits = 4, scipen = 1000000000)48options(shiny.maxRequestSize=30*1024^2)49 50 51 52ui <- fluidPage(53 theme = bs_theme(version = 5, bootswatch = "spacelab"),54 useShinyjs(), # Initialize shinyjs55 titlePanel("PtteM Data Science"),56 tags$head(tags$link(rel = "stylesheet", href="https://fonts.googleapis.com/css?family=Montserrat:100,300,400,700&display=swap"),57 tags$style(HTML("58 body, h1, h2, h3, h4, h5, h6, .nav, p, a, .shiny-input-container {59 font-family: 'Montserrat'; /* Font type for the title attribute */60 font-weight: 385;61 color: #007c9e !important;62 }63 * {64 font-family: 'Montserrat', sans-serif;65 font-weight: 385; 66 color: #195576; /* Blue color */67 }68 body { 69 background-color: #f7f7f7; /* Light gray background */70 }71 .icon-btn {72 border: 1px solid #0d6efd; /* Example border: solid, 2 pixels, #555 color */73 border-radius: 15%; /* Circular border */74 color: #00969e; /* Icon color */75 font-family: 'Montserrat'; /* Font type for the title attribute */76 font-weight: 385;77 background-color: #f7f7f7;78 padding: 125px; /* Space around the icon */79 margin: 25px; /* Space around the button */80 font-size: 24px; /* Icon size */81 box-shadow: 0 2px 4px rgba(0,0,0,0.2);82 }83 .icon-btn:hover {84 color: #00969e; /* Icon color on hover */85 border-color: #007c9e;86 background-color: #ebfbfd;/* Border color on hover */87 }88 /* Add custom styles here */89 .shiny-input-container {90 margin-bottom: 15px;91 }92 .box {93 border: 1px solid #ddd;94 padding: 20px;95 border-radius: 50px;96 margin-bottom: 200px;97 gap: 200px;98 align-items: center;99 }100 #statsTable_wrapper {101 margin: 0 auto;102 }103 .shiny-output-error {104 border: 1px solid #FF0000; /* Red border on error */105 }106 /* If you want to change the font size of the tooltip, you can add custom CSS for the 'title' attribute's default styling. */107 "))),108 tags$head(109 # Include JavaScript to reload the page110 tags$script(HTML("111 document.addEventListener('DOMContentLoaded', function() {112 document.getElementById('myElement').style.color = '#0d6efd'; // Change to your desired color113 });114"))115 ),116 tags$head(117 tags$script(HTML("118 function reloadPage() {119 window.location.reload();120 }121 "))122 ),123 # Refresh button that calls the JavaScript function124 actionButton("refresh", "Refresh Analysis", onclick = "reloadPage();"),125 # Help Text or Information for the user126 helpText("Bu uygulama ile pekiştirmeli öğrenme başlığı altındaki veri bilimi fonksiyonlarına erişebilirsiniz."),127 #Reinforcement Learning128 h2("Reinforcement Learning Section"),129 tabsetPanel(130 tabPanel("Multi-Armed Bandit (MAB) Algorithms",131 tabsetPanel(132 tabPanel("Epsilon-Greedy",133 sidebarLayout(134 sidebarPanel(135 fileInput('epsgreefile', 'Upload Data File', accept = c(".csv", ".xlsx", ".xls")),136 uiOutput('selectActionColumn'),137 uiOutput('selectRewardColumn'),138 numericInput("epsilon", "Epsilon (Exploration Rate)", value = 0.1, min = 0, max = 1, step = 0.01),139 actionButton("runMAB", "Run MAB Decision"),140 HTML("<div>141 <h2>Epsilon-Greedy Modeli</h2>142 <p>Bu model, çok kollu haydut problemi (multi-armed bandit, MAB) gibi karar verme sorunlarında, keşif (exploration) ile sömürü (exploitation) arasındaki dengeyi yönetmek için kullanılır. Epsilon-Greedy algoritması, belirli bir olasılıkla rastgele bir aksiyon seçerek keşif yapmayı ve geri kalan zamanlarda en iyi performans gösteren aksiyonu seçerek sömürü yapmayı dengeler.</p>143 144 <h3>Kullanım Adımları:</h3>145 <ol>146 <li><strong>Veri Dosyası Yükleme:</strong> <code>fileInput</code> ile CSV, XLSX veya XLS formatında bir veri dosyası yükleyin.</li>147 <li><strong>Aksiyon ve Ödül Sütunlarının Seçilmesi:</strong> Dinamik UI aracılığıyla aksiyon ve ödül sütunlarını seçin.</li>148 <li><strong>Epsilon Değerinin Belirlenmesi:</strong> <code>numericInput</code> ile keşif oranını belirleyin (0 ile 1 arasında bir değer).</li>149 <li><strong>MAB Kararının Çalıştırılması:</strong> <code>Run MAB Decision</code> butonuna basarak algoritmayı çalıştırın ve seçilen aksiyonu gözlemleyin.</li>150 </ol>151 152 <h3>Epsilon-Greedy Modelinin Anlamı ve Kullanımı:</h3>153 <p>Model, belirli bir epsilon değeri ile rastgele aksiyonlar seçerek yeni fırsatları keşfederken, en yüksek ödülü veren aksiyonları tekrar seçerek mevcut bilgiden yararlanır. Bu yaklaşım, belirsizlik altında optimal karar verme stratejileri geliştirmek için kullanılır.</p>154 155 <h3>Uygulama Alanları:</h3>156 <p>Reklam yerleştirme, stok yönetimi, web sayfası optimizasyonu gibi birçok farklı alanda kullanılabilir.</p>157 158 <h3>Sonuçların Yorumlanması:</h3>159 <p>Algoritma, seçilen aksiyonları ve her bir aksiyonun toplam ödülünü gösterir. Bu bilgi, hangi stratejilerin en etkili olduğunu anlamak için kullanılabilir.</p>160</div>")161 162 ),163 mainPanel(164 tableOutput("actionResults"),165 textOutput("selectedAction"),166 )167 )168 ),169 tabPanel("Upper Confidence Bound (UCB)",170 sidebarLayout(171 sidebarPanel(172 fileInput("ucbfile", "Upload Data File", accept = c(".csv", ".xlsx", ".xls")),173 uiOutput("selectStrategyColucb"),174 uiOutput("selectRewardColucb"),175 numericInput("epsilon", "Epsilon (Exploration Rate)", value = 0.1, min = 0, max = 1, step = 0.01),176 actionButton("runMABucb", "Run MAB Decision"),177 HTML("<div>178 <h2>Üst Güven Sınırı (UCB) Modeli</h2>179 <p>Üst Güven Sınırı (UCB) modeli, çok kollu haydut problemlerinde bir stratejinin hem ödülünü hem de bu ödülün güvenilirliğini dikkate alarak karar verme sürecini optimize eder. Keşif ve sömürü arasındaki dengeyi dinamik bir şekilde yönetir.</p>180 181 <h3>Kullanım Adımları:</h3>182 <ol>183 <li><strong>Veri Dosyası Yükleme:</strong> <code>fileInput</code> aracılığıyla CSV, XLSX veya XLS formatında veri dosyası yükleyin.</li>184 <li><strong>Strateji ve Ödül Sütunlarının Seçilmesi:</strong> Dinamik UI üzerinden strateji ve ödül sütunlarını seçin.</li>185 <li><strong>Epsilon Değerinin Belirlenmesi:</strong> Keşif oranını belirlemek için <code>numericInput</code> aracını kullanın (0 ile 1 arasında bir değer).</li>186 <li><strong>MAB Kararının Çalıştırılması:</strong> <code>Run MAB Decision</code> butonu ile modeli çalıştırın ve sonuçları gözlemleyin.</li>187 </ol>188 189 <h3>UCB Modelinin Anlamı ve Kullanımı:</h3>190 <p>Model, her bir stratejinin ödülünün ortalama değerini ve bu ortalamanın güven aralığını hesaplar. Yüksek bir güven aralığına sahip stratejiler, potansiyel olarak keşfedilmemiş yüksek ödüllere işaret eder ve model, bu stratejileri denemeye yatkın hale gelir.</p>191 192 <h3>Uygulama Alanları:</h3>193 <p>Online reklamcılık, stok optimizasyonu ve web sitesi düzeni testleri gibi alanlarda etkili karar verme mekanizmaları geliştirmek için kullanılabilir.</p>194 195 <h3>Sonuçların Yorumlanması:</h3>196 <p>Model, her bir stratejinin kaç kez denendiğini, elde edilen toplam ödülü ve zamanla ödülün nasıl değiştiğini gösterir. Bu bilgiler, hangi stratejilerin uzun vadede en etkili olduğunu belirlemek için kullanılabilir.</p>197</div>")198 199 ),200 mainPanel(201 tabsetPanel(202 tabPanel("Results", tableOutput("actionResultsucb")),203 tabPanel("Reward History", plotlyOutput("rewardHistoryucb", width = "100%", height = "750px"))204 )205 )206 )207 ),208 tabPanel("Thompson Sampling",209 sidebarLayout(210 sidebarPanel(211 fileInput("tsfile", "Upload Data File", accept = c(".csv", ".xlsx", ".xls")),212 uiOutput("selectStrategyColumnTS"), # This should be in the UI part213 uiOutput("selectRewardColumnTS"),214 textInput("successConditionsTS", "Enter success conditions (comma separated)"),215 actionButton("runMABTS", "Run MAB Thompson Sampling"),216 HTML("<div>217 <h2>Thompson Örnekleme Modeli</h2>218 <p>Thompson Örnekleme, belirsizliği yönetmek ve en iyi sonucu veren stratejiyi dinamik olarak belirlemek için olasılık modellerini kullanır. Çok kollu haydut problemlerinde kullanılır ve hem keşif hem de sömürü eylemlerini dengeler.</p>219 220 <h3>Kullanım Adımları:</h3>221 <ol>222 <li><strong>Veri Dosyası Yükleme:</strong> <code>fileInput</code> aracılığıyla uygun formatta (CSV, XLSX, XLS) veri dosyası yükleyin.</li>223 <li><strong>Strateji ve Ödül Sütunlarının Seçimi:</strong> Yüklenen veri setinden strateji ve ödül sütunlarını seçmek için dinamik UI araçlarını kullanın.</li>224 <li><strong>Başarı Koşullarının Girilmesi:</strong> Başarılı sonuçları belirlemek için <code>textInput</code> aracı ile virgülle ayrılmış başarı koşullarını girin.</li>225 <li><strong>MAB Thompson Örnekleme Çalıştırma:</strong> <code>Run MAB Thompson Sampling</code> butonu ile modeli çalıştırın ve stratejilerin performansını değerlendirin.</li>226 </ol>227 228 <h3>Modelin Anlamı ve Kullanımı:</h3>229 <p>Thompson Örnekleme modeli, her bir stratejinin başarı olasılığını güncelleyerek en iyi stratejiyi seçer. Model, zamanla elde edilen öğrenmeleri dikkate alarak dinamik bir şekilde strateji seçimi yapar.</p>230 231 <h3>Uygulama Alanları:</h3>232 <p>Dijital pazarlama kampanyalarının optimizasyonu, stok seçimi ve finansal yatırım stratejileri gibi çeşitli alanlarda karar verme süreçlerini iyileştirmek için kullanılabilir.</p>233 234 <h3>Sonuçların Yorumlanması:</h3>235 <p>Model, her stratejinin başarı oranını ve zaman içindeki performansını gösterir. Bu sonuçlar, uzun vadeli karar verme süreçlerinde stratejik yön belirlemede kullanılabilir.</p>236</div>")237 238 ),239 mainPanel(240 tabsetPanel(241 tabPanel("Best Display", verbatimTextOutput("bestStrategyDisplayTS")),242 tabPanel("Reward History TS", plotlyOutput("rewardHistoryTS", width = "100%", height = "750px")),243 tabPanel("Strategy Frequency", plotlyOutput("strFrePlotTS", width = "100%", height = "750px"))244 )245 )246 )247 ),248 249 250 )251 ),252 tabPanel("Contextual Bandits",253 tabsetPanel(254 tabPanel("Linear Regression UCB",255 sidebarLayout(256 sidebarPanel(257 fileInput("lrucbfile", "Upload your dataset", accept = c(".csv", ".xlsx", ".xls")),258 actionButton("loadlrucb", "Load Data"),259 selectInput("targetlrucb", "Select Target Column", choices = NULL),260 selectizeInput("independentVarlrucb", "Select Independent Variable", choices = NULL, multiple = FALSE),261 actionButton("runModellrucb", "Run Linear Regression UCB"),262 HTML("<div>263 <h2>Doğrusal Regresyon UCB</h2>264 <p>Doğrusal Regresyon UCB, belirsizlik altında en iyi kararları vermek için üst güven sınırını kullanır. Özellikle, çok değişkenli verilerde, hangi bağımsız değişkenlerin hedef değişken üzerinde önemli etkiye sahip olduğunu belirlemek için kullanılır.</p>265 266 <h3>Kullanım Adımları:</h3>267 <ol>268 <li><strong>Veri Dosyası Yükleme:</strong> <code>fileInput</code> ile CSV, XLSX veya XLS formatında veri dosyası yükleyin.</li>269 <li><strong>Veri Yükleme:</strong> <code>Load Data</code> butonu ile yüklenen veri dosyasını sisteme yükleyin.</li>270 <li><strong>Hedef ve Bağımsız Değişken Seçimi:</strong> Analiz için hedef ve bağımsız değişkenleri seçin.</li>271 <li><strong>Modeli Çalıştır:</strong> <code>Run Linear Regression UCB</code> butonu ile doğrusal regresyon modelini çalıştırın.</li>272 </ol>273 274 <h3>Modelin Anlamı ve Kullanımı:</h3>275 <p>Doğrusal Regresyon UCB, belirsizliği yönetmek ve veriler arasındaki ilişkileri anlamak için kullanılır. UCB, bir değişkenin model üzerindeki etkisini değerlendirirken belirsizliği dikkate alır.</p>276 277 <h3>Uygulama Alanları:</h3>278 <p>Finansal tahminler, ürün fiyatlandırma stratejileri ve pazar araştırması gibi çeşitli alanlarda karar verme süreçlerinde kullanılabilir.</p>279 280 <h3>Sonuçların Yorumlanması:</h3>281 <p>Model, seçilen bağımsız değişkenin hedef değişken üzerindeki etkisini ve bu etkinin güven aralığını gösterir. Sonuçlar, stratejik planlama ve karar verme süreçlerinde kullanılabilir.</p>282</div>")283 284 ),285 mainPanel(286 tabsetPanel(287 tabPanel("Model Summary", verbatimTextOutput("modelSummarylrucb")),288 tabPanel("Diagnostics",289 plotlyOutput("resFitlrucbPlot"),290 plotlyOutput("qqPlotlrucb"),291 plotlyOutput("scaleLoclrucbPlot"),292 plotlyOutput("resLevlrucbPlot")293 ),294 tabPanel("Regression Plot", plotlyOutput("regressionPlot", width = "100%", height = "750px"))295 )296 )297 )298 )299 300 301 )302 )303 )304 305 306 307)308 309server <- function(input, output, session) {310 ##Reinforcement Learning311 ###Multi-Armed Bandit (MAB) Algorithms312 ####Epsilon-Greedy313 # Reactive to store uploaded data314 uploadedepsgree <- reactive({315 req(input$epsgreefile)316 ext <- tools::file_ext(input$epsgreefile$name)317 switch(ext,318 csv = read.csv(input$epsgreefile$datapath, stringsAsFactors = FALSE),319 xlsx = readxl::read_excel(input$epsgreefile$datapath),320 stop("Unsupported file type"))321 })322 323 # Dynamic UI to select the action and reward columns324 output$selectActionColumn <- renderUI({325 df <- uploadedepsgree()326 req(df)327 selectInput("actionColumn", "Select Action Column", choices = names(df))328 })329 330 output$selectRewardColumn <- renderUI({331 df <- uploadedepsgree()332 req(df)333 selectInput("rewardColumn", "Select Reward Column", choices = names(df))334 })335 336 # Reactive values to store actions and performance metrics337 actionRewards <- reactiveValues(actions = NULL, rewards = NULL, counts = NULL)338 339 observeEvent(input$runMAB, {340 req(input$epsilon, input$actionColumn, input$rewardColumn)341 df <- uploadedepsgree()342 df <- df %>% dplyr::select(all_of(input$actionColumn), all_of(input$rewardColumn)) %>% na.omit() 343 uniqueActions <- unique(df[[input$actionColumn]])344 summedRewards <- tapply(df[[input$rewardColumn]], df[[input$actionColumn]], sum, na.rm = TRUE)345 346 # Store processed data in actionRewards347 actionRewards$actions <- uniqueActions348 actionRewards$rewards <- summedRewards349 actionRewards$counts <- rep(10, length(uniqueActions)) # Initialize with some counts350 351 # Run epsilon-greedy algorithm352 if (runif(1) < input$epsilon) {353 # Exploration354 selectedActionIndex <- sample(length(uniqueActions), 1)355 } else {356 # Exploitation357 averages <- summedRewards / actionRewards$counts358 selectedActionIndex <- which.max(averages)359 }360 361 selectedAction <- uniqueActions[selectedActionIndex]362 simulatedReward <- runif(1, min = 0, max = max(summedRewards)) # Simulate a reward363 actionRewards$rewards[selectedActionIndex] <- actionRewards$rewards[selectedActionIndex] + simulatedReward364 actionRewards$counts[selectedActionIndex] <- actionRewards$counts[selectedActionIndex] + 1365 366 # Update UI367 output$selectedAction <- renderText({ selectedAction })368 output$actionResults <- renderTable({369 data.frame(Action = actionRewards$actions, Reward = actionRewards$rewards, Count = actionRewards$counts)370 })371 })372 373 ####Upper Confidence Bound (UCB)374 # Reactive values to store actions and performance metrics375 actionData <- reactiveValues(376 actions = NULL,377 counts = NULL,378 rewards = NULL,379 history = list() # Initialize the history list here380 )381 382 uploadeducb <- reactive({383 req(input$ucbfile)384 ext <- tools::file_ext(input$ucbfile$name)385 switch(ext,386 csv = read.csv(input$ucbfile$datapath, stringsAsFactors = FALSE),387 xlsx = readxl::read_excel(input$ucbfile$datapath),388 xls = readxl::read_excel(input$ucbfile$datapath),389 stop("Unsupported file type")390 )391 })392 393 output$selectStrategyColucb <- renderUI({394 req(input$ucbfile)395 data <- uploadeducb()396 selectInput("strategyColumn", "Select Strategy Column",397 choices = names(data), selected = names(data)[1])398 })399 400 output$selectRewardColucb <- renderUI({401 req(input$ucbfile)402 data <- uploadeducb()403 selectInput("rewardColumn", "Select Reward Column",404 choices = names(data), selected = names(data)[2])405 })406 407 408 409 observeEvent(input$runMABucb, {410 411 data <- uploadeducb()412 strategyColumn <- input$strategyColumn413 rewardColumn <- input$rewardColumn414 415 # Ensure numerical data for computation416 data[[rewardColumn]] <- as.numeric(as.character(data[[rewardColumn]]))417 418 # Unique strategies419 strategies <- unique(data[[strategyColumn]])420 n <- nrow(data) # Total number of events421 422 if (is.null(actionData$actions)) {423 actionData$actions <- strategies424 actionData$counts <- rep(0, length(strategies))425 actionData$rewards <- rep(0, length(strategies))426 # Initialize history for each strategy427 actionData$history <- setNames(vector("list", length(strategies)), strategies)428 for(strategy in strategies) {429 actionData$history[[strategy]] <- data.frame(Time = integer(), Reward = numeric())430 }431 }432 433 # Loop over strategies to compute UCB and update history434 for (strategy in strategies) {435 strategy_data <- data[data[[strategyColumn]] == strategy, ]436 ni <- nrow(strategy_data) # Number of times this strategy was tried437 avg_reward <- mean(strategy_data[[rewardColumn]], na.rm = TRUE)438 439 if (ni > 0) {440 ucb_value <- avg_reward + sqrt((2 * log(n)) / ni)441 } else {442 ucb_value <- Inf # Encourage exploration of untried strategies443 }444 # Define strategy_index here, inside the loop, before you use it445 strategy_index <- which(actionData$actions == strategy)446 447 actionData$counts[strategy_index] <- actionData$counts[strategy_index] + ni448 actionData$rewards[strategy_index] <- ucb_value449 actionData$history[[strategy]] <- rbind(450 actionData$history[[strategy]],451 data.frame(Time = as.integer(actionData$counts[strategy_index]), Reward = ucb_value)452 )453 }454 # After the loop, the history should be updated455 })456 457 output$actionResultsucb <- renderTable({458 req(actionData$actions) # Ensure the action data is not NULL459 data.frame(460 Strategy = actionData$actions, 461 Counts = actionData$counts, 462 Rewards = actionData$rewards463 )464 })465 466 467 468 # Create the plot in a separate reactive context, responding to changes in actionData469 output$rewardHistoryucb <- renderPlotly({470 req(actionData$history) # Ensure that the history is not NULL or empty471 472 # Create plot_data for plotting473 plot_data <- do.call(rbind, Filter(Negate(is.null), lapply(names(actionData$history), function(strategy) {474 history_data <- actionData$history[[strategy]]475 if(nrow(history_data) > 0) {476 return(data.frame(Strategy = strategy, Time = history_data$Time, Reward = history_data$Reward))477 }478 })))479 480 # Only attempt to create a plot if plot_data is a data frame and not NULL481 if(!is.null(plot_data) && is.data.frame(plot_data)) {482 # Create a custom color palette with as many colors as there are strategies483 colors <- grDevices::colorRampPalette(RColorBrewer::brewer.pal(8, "Set2"))(length(unique(plot_data$Strategy)))484 485 plot_ly(plot_data, x = ~Time, y = ~Reward, color = ~Strategy, colors = colors, type = 'scatter', mode = 'lines+markers') %>%486 layout(title = "Reward History Over Time",487 xaxis = list(title = "Time"),488 yaxis = list(title = "Reward"))489 } else {490 plot_ly() %>% 491 add_annotations(text = "No data available for plot", x = 0.5, y = 0.5, showarrow = FALSE, xref = "paper", yref = "paper")492 }493 })494 495 ####Thompson Sampling496 uploadedTS <- reactive({497 req(input$tsfile)498 ext <- tools::file_ext(input$tsfile$name)499 switch(ext,500 csv = read.csv(input$tsfile$datapath, stringsAsFactors = FALSE),501 xlsx = readxl::read_excel(input$tsfile$datapath),502 xls = readxl::read_excel(input$tsfile$datapath),503 stop("Unsupported file type: ", ext)504 )505 })506 507 # Initialize actionDataTS similar to actionData for UCB508 actionDataTS <- reactiveValues(509 actions = NULL,510 successes = NULL,511 failures = NULL,512 theta = NULL513 )514 515 516 output$selectStrategyColumnTS <- renderUI({517 req(input$tsfile)518 data <- uploadedTS()519 selectInput("selectStrategyColumnTS", "Select Strategy Column",520 choices = names(data), selected = names(data)[1])521 })522 523 output$selectRewardColumnTS <- renderUI({524 req(input$tsfile)525 data <- uploadedTS()526 selectInput("selectRewardColumnTS", "Select Reward Column",527 choices = names(data), selected = names(data)[2])528 })529 530 531 observeEvent(input$runMABTS, {532 req(input$tsfile)533 data <- uploadedTS() 534 535 strategyColumn <- input$selectStrategyColumnTS536 rewardColumn <- input$selectRewardColumnTS537 success_conditions <- unlist(strsplit(input$successConditionsTS, ",")) # split the input string into a vector538 539 if (is.null(actionDataTS$actions)) {540 actionDataTS$actions <- unique(data[[strategyColumn]])541 actionDataTS$successes <- rep(1, length(actionDataTS$actions)) # Start with 1 success for beta distribution542 actionDataTS$failures <- rep(1, length(actionDataTS$actions)) # Start with 1 failure for beta distribution543 actionDataTS$theta <- rep(0, length(actionDataTS$actions))544 actionDataTS$history <- list() # Initialize history for plotting545 actionDataTS$selectionCount <- rep(0, length(actionDataTS$actions)) # Initialize with zeros546 }547 548 for (strategy in actionDataTS$actions) {549 strategy_index <- which(actionDataTS$actions == strategy)550 551 # Define strategy_data and num_successes/num_failures after defining strategy_index552 strategy_data <- data[data[[strategyColumn]] == strategy, ]553 strategy_data[[rewardColumn]] <- as.numeric(strategy_data[[rewardColumn]] %in% success_conditions) # Convert to binary554 555 num_successes <- sum(strategy_data[[rewardColumn]], na.rm = TRUE)556 num_failures <- nrow(strategy_data) - num_successes557 558 actionDataTS$successes[strategy_index] <- actionDataTS$successes[strategy_index] + num_successes559 actionDataTS$failures[strategy_index] <- actionDataTS$failures[strategy_index] + num_failures560 actionDataTS$theta[strategy_index] <- rbeta(1, actionDataTS$successes[strategy_index], actionDataTS$failures[strategy_index])561 actionDataTS$selectionCount[strategy_index] <- actionDataTS$selectionCount[strategy_index] + 1562 563 # Update the history with the new data for plotting564 if (is.null(actionDataTS$history[[strategy]])) {565 actionDataTS$history[[strategy]] <- data.frame(Time = seq_along(strategy_data[[rewardColumn]]), Reward = strategy_data[[rewardColumn]])566 } else {567 actionDataTS$history[[strategy]] <- rbind(actionDataTS$history[[strategy]], data.frame(Time = seq_along(strategy_data[[rewardColumn]]) + nrow(actionDataTS$history[[strategy]]), Reward = strategy_data[[rewardColumn]]))568 }569 }570 })571 572 output$bestStrategyDisplayTS <- renderPrint({573 req(actionDataTS$theta) # Ensure theta values have been calculated574 best_strategy_index <- which.max(actionDataTS$theta)575 best_strategy <- actionDataTS$actions[best_strategy_index] # Ensure this variable matches throughout your code576 theta_value <- actionDataTS$theta[best_strategy_index]577 578 cat("The best strategy is:", best_strategy, "\n",579 "Estimated success probability (theta):", theta_value)580 })581 582 583 createPlotData <- function(history) {584 if (is.list(history) && length(history) > 0 && all(sapply(history, is.data.frame))) {585 # Combine all strategy data frames into one, adding a 'Strategy' column586 plot_data <- do.call(rbind, lapply(names(history), function(strategy) {587 strategy_data <- history[[strategy]]588 if ("Time" %in% names(strategy_data) && "Reward" %in% names(strategy_data)) {589 strategy_data$Strategy <- strategy # Add the 'Strategy' column590 return(strategy_data)591 } else {592 # Return a data frame with missing values if required columns are not present593 return(data.frame(Time = NA, Reward = NA, Strategy = strategy))594 }595 }))596 # Remove rows with missing values597 plot_data <- na.omit(plot_data)598 return(plot_data)599 } else {600 # If history is not as expected, return an empty data frame with the correct columns601 return(data.frame(Time = integer(0), Reward = numeric(0), Strategy = factor()))602 }603 }604 605 606 output$rewardHistoryTS <- renderPlotly({607 req(actionDataTS$history) # Ensure that the history is not NULL or empty608 609 # Create the required plot_data using the createPlotData function610 plot_data <- createPlotData(actionDataTS$history)611 612 # Check if the plot_data has rows to plot613 if (!is.null(plot_data) && nrow(plot_data) > 0) {614 # Create the plot with plotly615 plot_ly(616 data = plot_data,617 x = ~Time,618 y = ~Reward,619 color = ~Strategy,620 type = 'scatter', # Use 'scatter' for line and point plots621 mode = 'markers', # Combine line and marker styles622 marker = list(color = 'rgba(74, 93, 191, 0.7))', line = list(color = 'rgba(55, 128, 191, 1.0)', width = 2)) # Optionally, adjust marker size623 ) %>%624 layout(625 title = "Reward History Over Time",626 xaxis = list(title = "Time"),627 yaxis = list(title = "Reward"),628 hovermode = 'closest' # Improves tooltip behavior629 )630 } else {631 # Provide a message or an empty plot if plot_data is empty632 return(plotly_empty())633 }634 })635 output$strFrePlotTS <- renderPlotly({636 req(input$tsfile) # Make sure a file is uploaded637 data <- uploadedTS() # Get the uploaded data638 639 # Calculate the frequency of each strategy640 strategy_freq <- table(data[[input$selectStrategyColumnTS]])641 642 # Convert to a data frame for plotting643 strategy_freq_df <- as.data.frame(strategy_freq)644 645 # Create the plot with plotly646 plot_ly(647 data = strategy_freq_df,648 x = ~Var1, # The strategy names649 y = ~Freq, # The frequency counts650 type = 'scatter', # Use a scatter chart651 mode = 'markers',652 marker = list(color = 'rgba(74, 93, 191, 0.7)', line = list(color = 'rgba(55, 128, 191, 1.0)', width = 2))653 ) %>%654 layout(655 title = "Strategy Frequency",656 xaxis = list(title = "Strategy"),657 yaxis = list(title = "Frequency"),658 hovermode = 'closest'659 )660 })661 662 ####Linear Regression UCB663 # Reactive value to store preprocessed data664 datalrucb <- reactiveVal(NULL)665 modelsList <- reactiveVal(list())666 # Function to read and clean data667 read_data <- function(filepath) {668 ext <- tools::file_ext(filepath)669 if (ext == "csv") {670 read.csv(filepath, stringsAsFactors = FALSE)671 } else if (ext == "xlsx") {672 readxl::read_excel(filepath)673 } else {674 stop("Invalid file format. Please select a CSV or XLSX file.")675 }676 }677 678 clean_column_names <- function(dataframe) {679 colnames(dataframe) <- gsub("[^[:alnum:]_]", "", make.names(colnames(dataframe), unique = TRUE))680 return(dataframe)681 }682 683 # Observe load data button click684 observeEvent(input$loadlrucb, {685 file <- input$lrucbfile686 req(file)687 data_lrucb <- read_data(file$datapath)688 data_lrucb <- clean_column_names(data_lrucb)689 datalrucb(data_lrucb) # Store the data690 updateSelectInput(session, "targetlrucb", choices = colnames(data_lrucb))691 updateSelectizeInput(session, "independentVarlrucb", choices = setdiff(colnames(data_lrucb), input$targetlrucb))692 })693 694 # Function to perform safe regression695 safe_regression <- function(data, responseVar, var) {696 tryCatch({697 # Print types to debug698 #print(paste("Type of response variable:", class(data[[responseVar]])))699 #print(paste("Type of independent variable:", class(data[[var]])))700 701 #if(!is.numeric(data[[var]])) {702 #stop(paste(var, "is not numeric and will be skipped."))703 #}704 #if(!is.numeric(data[[responseVar]])) {705 #stop(paste(responseVar, "is not numeric and will be skipped."))706 #}707 708 # Check for missing or infinite values709 #if(any(!is.finite(data[[var]])) || any(!is.finite(data[[responseVar]]))) {710 #stop("Non-finite values detected in variables.")711 #}712 # Assuming 'data' is your data frame and 'responseVar' and 'var' are column names713 data <- na.omit(data[c(responseVar, var)])714 formula <- as.formula(paste(responseVar, "~", var))715 model <- lm(formula, data = data)716 summary_model <- summary(model)717 ucb_estimate <- summary_model$coefficients[var, "Estimate"]718 # Store the entire model object along with variable names719 return(list(variable = var, model = model, ucb_estimate = ucb_estimate))720 }, error = function(e) {721 message("Error in regression with variable: ", var, "; Error: ", e$message)722 return(NULL) # Skip this variable723 })724 }725 726 727 # Perform regression on Run Model button click728 observeEvent(input$runModellrucb, {729 data <- req(datalrucb())730 responseVar <- req(input$targetlrucb)731 var <- req(input$independentVarlrucb)732 733 if(!responseVar %in% names(data)) {734 stop("Selected response variable is not in the dataset.")735 }736 737 results <- safe_regression(data, responseVar, var)738 modelsList(list(results)) # Append new result to the list739 output$modelSummarylrucb <- renderPrint({740 req(results)741 if (is.null(results$ucb_estimate)) {742 paste("Regression could not be performed for variable:", var)743 } else {744 paste("UCB estimate for variable", var, "is", results$ucb_estimate)745 }746 })747 })748 749 # Server function to create diagnostic plots750 output$resFitlrucbPlot <- renderPlotly({751 req(modelsList(), datalrucb())752 models <- req(modelsList())753 754 # Use the first model for the plot as an example755 if (length(models) >= 1 && !is.null(models[[1]]$model)) {756 fitted_model <- models[[1]]$model757 p <- ggplot(fitted_model, aes(.fitted, .resid)) +758 geom_point(color = "darkorange") +759 geom_smooth(method = "lm", se = FALSE, color = "dodgerblue") +760 labs(title = "Residuals vs Fitted", x = "Fitted Values", y = "Residuals")761 762 ggplotly(p)763 } else {764 return(NULL) # No models to plot765 }766 })767 768 769 output$qqPlotlrucb <- renderPlotly({770 req(modelsList(), datalrucb())771 models <- req(modelsList())772 773 # Use the first model for the plot as an example774 if (length(models) >= 1 && !is.null(models[[1]]$model)) {775 fitted_model <- models[[1]]$model776 p <- ggplot(fitted_model, aes(sample = .stdresid)) +777 stat_qq(color = "darkorange") +778 stat_qq_line(color = "dodgerblue") +779 labs(title = "Normal Q-Q")780 781 ggplotly(p)782 } else {783 return(NULL) # No models to plot784 }785 })786 787 output$scaleLoclrucbPlot <- renderPlotly({788 req(modelsList(), datalrucb())789 models <- req(modelsList())790 791 # Use the first model for the plot as an example792 if (length(models) >= 1 && !is.null(models[[1]]$model)) {793 fitted_model <- models[[1]]$model794 p <- ggplot(fitted_model, aes(.fitted, sqrt(abs(.resid)))) +795 geom_point(color = "darkorange") +796 geom_smooth(method = "lm", se = FALSE, color = "dodgerblue") +797 labs(title = "Scale-Location", x = "Fitted Values", y = "Sqrt(|Residuals|)")798 799 ggplotly(p)800 } else {801 return(NULL) # No models to plot802 }803 })804 805 output$resLevlrucbPlot <- renderPlotly({806 req(modelsList(), datalrucb())807 models <- req(modelsList())808 809 # Use the first model for the plot as an example810 if (length(models) >= 1 && !is.null(models[[1]]$model)) {811 fitted_model <- models[[1]]$model812 p <- ggplot(fitted_model, aes(.hat, .stdresid)) +813 geom_point(aes(size = .cooksd), shape = 1, color = "darkorange") +814 geom_smooth(method = "lm", se = FALSE, color = "dodgerblue") +815 labs(title = "Residuals vs Leverage", x = "Leverage", y = "Standardized Residuals")816 817 ggplotly(p)818 } else {819 return(NULL) # No models to plot820 }821 })822 823 output$regressionPlot <- renderPlotly({824 req(modelsList(), datalrucb())825 fitted_model <- modelsList()826 data_for_plot <- datalrucb()827 828 # Ensure the target and independent variables are provided829 target_col <- input$targetlrucb830 independent_var <- input$independentVarlrucb831 if (is.null(data_for_plot[[target_col]]) || is.null(data_for_plot[[independent_var]])) {832 return("Target or independent variable not found in the data.")833 }834 835 # Creating the plot with added color836 p <- ggplot(data_for_plot, aes_string(x = independent_var, y = target_col)) +837 geom_point(color = "darkorange") + # Change color of points838 geom_smooth(method = "lm", se = FALSE, color = "dodgerblue") + # Change color of regression line839 ggtitle("Regression Line Plot") +840 xlab(independent_var) +841 ylab(target_col) +842 theme_minimal() + # Adding a minimal theme for a cleaner look843 theme(legend.position = "none") # Remove legend if not needed844 845 # Convert ggplot object to Plotly for an interactive plot846 ggplotly(p)847 }) 848 849}850 851shinyApp(ui, server)