diff --git a/dynamic_programming/viterbi.r b/dynamic_programming/viterbi.r new file mode 100644 index 00000000..a1daed3f --- /dev/null +++ b/dynamic_programming/viterbi.r @@ -0,0 +1,115 @@ +# ============================================================== +# Viterbi Algorithm — Hidden Markov Model (HMM) Decoding +# ============================================================== +# +# Description: +# The Viterbi algorithm finds the most probable sequence of +# hidden states (state path) that results in a given sequence of +# observed events in a Hidden Markov Model. +# +# Time Complexity: O(N * T) +# - N = number of hidden states +# - T = length of observation sequence +# +# Space Complexity: O(N * T) +# +# Input: +# states - vector of hidden states +# observations - vector of observed symbols +# start_prob - named vector of initial probabilities (state → prob) +# trans_prob - matrix of transition probabilities (from_state → to_state) +# emit_prob - matrix of emission probabilities (state → observation) +# +# Output: +# A list containing: +# best_path - most probable state sequence +# best_prob - probability of the best path +# +# Example usage provided at bottom of file. +# ============================================================== + +viterbi <- function(states, observations, start_prob, trans_prob, emit_prob) { + N <- length(states) + T_len <- length(observations) + + # Initialize matrices + V <- matrix(0, nrow = N, ncol = T_len) # probability table + path <- matrix(NA, nrow = N, ncol = T_len) # backpointer table + + # Initialization step + for (i in 1:N) { + V[i, 1] <- start_prob[states[i]] * emit_prob[states[i], observations[1]] + path[i, 1] <- 0 + } + + # Recursion step + for (t in 2:T_len) { + for (j in 1:N) { + probs <- V[, t - 1] * trans_prob[, states[j]] * emit_prob[states[j], observations[t]] + V[j, t] <- max(probs) + path[j, t] <- which.max(probs) + } + } + + # Termination step + best_last_state <- which.max(V[, T_len]) + best_prob <- V[best_last_state, T_len] + + # Backtrack the best path + best_path <- rep(NA, T_len) + best_path[T_len] <- best_last_state + + if (T_len > 1) { + for (t in rev(seq_len(T_len - 1))) { + best_path[t] <- path[best_path[t + 1], t + 1] + } + } + + best_state_sequence <- states[best_path] + + return(list( + best_path = best_state_sequence, + best_prob = best_prob + )) +} + +# ============================================================== +# Example Usage and Test +if (interactive()) { + cat("=== Viterbi Algorithm — Hidden Markov Model ===\n") + + # Example: Weather HMM + # States: Rainy, Sunny + # Observations: walk, shop, clean + states <- c("Rainy", "Sunny") + observations <- c("walk", "shop", "clean") + + # Start probabilities + start_prob <- c(Rainy = 0.6, Sunny = 0.4) + + # Transition probabilities + trans_prob <- matrix(c( + 0.7, 0.3, # from Rainy to (Rainy, Sunny) + 0.4, 0.6 # from Sunny to (Rainy, Sunny) + ), nrow = 2, byrow = TRUE) + rownames(trans_prob) <- states + colnames(trans_prob) <- states + + # Emission probabilities + emit_prob <- matrix(c( + 0.1, 0.4, 0.5, # Rainy emits (walk, shop, clean) + 0.6, 0.3, 0.1 # Sunny emits (walk, shop, clean) + ), nrow = 2, byrow = TRUE) + rownames(emit_prob) <- states + colnames(emit_prob) <- observations + + # Observed sequence + obs_seq <- c("walk", "shop", "clean") + + cat("Observation sequence:", paste(obs_seq, collapse = ", "), "\n") + result <- viterbi(states, obs_seq, start_prob, trans_prob, emit_prob) + + cat("Most probable state sequence:\n") + cat(paste(result$best_path, collapse = " -> "), "\n") + cat("Probability of this sequence:", result$best_prob, "\n") +} diff --git a/et --soft HEAD~1 b/et --soft HEAD~1 new file mode 100644 index 00000000..e9c4e0df --- /dev/null +++ b/et --soft HEAD~1 @@ -0,0 +1,461 @@ +commit 7d4b7af52036b21abf54435f14250ef170351389 (HEAD -> Graph_colouring) +Author: Prathamesh Kalshetti +Date: Sun Oct 19 13:56:38 2025 +0530 + + graph_colouring + +commit 4921341b2921457245427d4b465e0eb1478f28e6 (origin/feat-viterbi, feat-viterbi, feat-bidirectional_bfs) +Author: Prathamesh Kalshetti +Date: Sat Oct 18 12:35:09 2025 +0530 + + viterbi + +commit 8b30acf58c4636541e76801c4f9f22dfcd53d85b (origin/feat-bidirectional_bfs, master) +Author: Prathamesh Kalshetti +Date: Sat Oct 18 11:44:39 2025 +0530 + + bidirectional_bfs + +commit b083bc9dcffa63af4210cb5b8664246a4a0cf941 (origin/master, origin/HEAD) +Author: PIYUSH KUMAR SINGH <121piyush466mits@gmail.com> +Date: Thu Oct 16 20:02:54 2025 +0530 + + Add Knuth-Morris-Pratt (KMP) string matching algorithm [HACKTOBERFEST 2025] (#157) + +commit 1ae8bda8c22c4d580f7c6e7cdc457125328acadb +Author: Pratik +Date: Wed Oct 15 03:15:51 2025 +0530 + + [FEATURE] Add Jump Search Algorithm Implementation in R (#216) + +commit 65e82bffad452bcc0237df9551acfc90e3d69243 +Author: Pratik +Date: Sun Oct 12 19:04:20 2025 +0530 + + Add comprehensive Value at Risk (VaR) and Expected Shortfall (ES) calculator (#201) + +commit a5cbeecd63b6efedd7fc9a94d61143e73115a0dc +Author: Pratik +Date: Sun Oct 12 19:00:13 2025 +0530 + + Add Time Series Analysis and ARIMA Modeling Implementation in R (#202) + +commit d711ac1f0db4909653825ae531968c4393e27fff +Author: Andrii Siriak +Date: Sun Oct 12 16:26:48 2025 +0300 + + Create stale.yml + +commit 69a0c3045cade6b7c8409f55a0d4b5ae29a1b083 +Author: Pratik +Date: Sun Oct 12 18:53:20 2025 +0530 + + Add Floyd–Warshall All-Pairs Shortest Path Algorithm Implementation in R (#203) + +commit 6d15d42ac89877ab1a54cf5707c03cc3a659947e +Author: Pratik +Date: Sun Oct 12 15:18:30 2025 +0530 + + created a comprehensive Black-Scholes option pricing algorithm (#200) + +commit 79ca778cf37b2fca295f893ed00785e61f2396a8 +Author: Pratik +Date: Sun Oct 12 15:18:20 2025 +0530 + + Implement Gradient Boosting Regressor with Decision Trees in R (#199) + +commit e6c0b52d8e1300b88c6971e45f87745425bcf4a4 +Author: Pratik +Date: Sun Oct 12 15:18:11 2025 +0530 + + Tarjan's Bridge Finding Algorithm (#198) + +commit b811a36c4f33cf4551f3196a1735319f861a9bb5 +Author: Pratik +Date: Sun Oct 12 13:42:20 2025 +0530 + + feat : Add the Bellman-Ford Shortest Path Algorithm in R (#192) + +commit 47ff5ed6db5ae97765218b89073c2ea96b8cc5e7 +Author: Srishti Soni <92056170+shimmer12@users.noreply.github.com> +Date: Sun Oct 12 02:41:13 2025 +0530 + + Add modular exponentiation function (#194) + +commit b5d1199c77508d1bb99c4c7bda1cb44a19570556 +Author: Srishti Soni <92056170+shimmer12@users.noreply.github.com> +Date: Sun Oct 12 02:40:30 2025 +0530 + + Implement Newton-Raphson method in R (#196) + +commit b90abace62e50712a58eba9ff717f89fe87434de +Author: Srishti Soni <92056170+shimmer12@users.noreply.github.com> +Date: Sun Oct 12 02:38:56 2025 +0530 + + Add one-way ANOVA function implementation (#195) + +commit 7a5ea9c1aa0c3e79557515e083b646c408a84d48 +Author: Sachin Pangal <151670745+Orthodox-64@users.noreply.github.com> +Date: Sun Oct 12 02:21:20 2025 +0530 + + Implemented the Subset Sum Problem algorithm in R. (#171) + +commit 52f65cfbc046862917dc33a28cff489cca0fdfbb +Author: Pratik +Date: Sun Oct 12 02:19:57 2025 +0530 + + Add Catalan Numbers algorithm implementation (#191) + +commit aa686ce907b27380ca30a23afa1f6d06a12766e4 +Author: Sachin Pangal <151670745+Orthodox-64@users.noreply.github.com> +Date: Sat Oct 11 16:25:05 2025 +0530 + + Implemented the Minimum Path Sum algorithm in R. (#172) + +commit e33a9c68b50d209d76c019a0456c2422664ee535 +Author: Arpita Roy <100989922+Arpita23r@users.noreply.github.com> +Date: Sat Oct 11 16:23:24 2025 +0530 + + feat: added ternary search (#177) + +commit 4c17308965c2067587ca2b4c70b23ed632fda5f9 +Author: Sachin Pangal <151670745+Orthodox-64@users.noreply.github.com> +Date: Sat Oct 11 16:19:47 2025 +0530 + + Implemented the Matrix Chain Multiplication algorithm in R. (#173) + +commit 66bc83f2bf75054b3f732036600966aa5c1022d8 +Author: Copilot <198982749+Copilot@users.noreply.github.com> +Date: Sat Oct 11 13:13:01 2025 +0300 + + Move misplaced algorithms to correct folders (#188) + +commit ad44b946ce0e0f47a94719f0f11b4eaaa1631661 +Author: Copilot <198982749+Copilot@users.noreply.github.com> +Date: Sat Oct 11 13:05:11 2025 +0300 + + ✨ Enhance Copilot instructions with comprehensive contribution guidelines (#190) + +commit 2c17bf7f083504f12a9aacdeae5b31d412585030 +Author: Andrii Siriak +Date: Sat Oct 11 11:48:57 2025 +0200 + + Create copilot-instructions.md (#186) + +commit b397c7d15dea0030aee1a454cd376537126c7386 +Author: Sachin Pangal <151670745+Orthodox-64@users.noreply.github.com> +Date: Sat Oct 11 14:58:38 2025 +0530 + + Implemented the Coin Change algorithm in R. (#170) + +commit 39b9816674da70109816746f9537790f56288d51 +Author: Arpita Roy <100989922+Arpita23r@users.noreply.github.com> +Date: Sat Oct 11 14:57:26 2025 +0530 + + added shortest common super sequence (#180) + +commit eb97f01a3a3dcc7fe28383bc5e9bfcc654527b48 +Author: Arpita Roy <100989922+Arpita23r@users.noreply.github.com> +Date: Sat Oct 11 14:55:38 2025 +0530 + + feat:added minimum palindromic insertion (#181) + +commit 7ca7e9555d8646666fd3ffd41bd2c527bb74b6ef +Author: Arpita Roy <100989922+Arpita23r@users.noreply.github.com> +Date: Sat Oct 11 14:42:34 2025 +0530 + + added manacher algorithm (#178) + +commit f9ad73230a7102c1fd7e9ad016b36b3efcfe39ea +Author: Arpita Roy <100989922+Arpita23r@users.noreply.github.com> +Date: Sat Oct 11 14:19:39 2025 +0530 + + add levenshtein (#179) + +commit 5bb715513cfdd49a4ffa987033dcf507bd890752 +Author: Arpita Roy <100989922+Arpita23r@users.noreply.github.com> +Date: Sat Oct 11 14:18:59 2025 +0530 + + feat: Add Z Algorithm string search in R (#176) + +commit e92a3f21a8cbae8d4828cd4f16b77adbdb64e076 +Author: Supratim <109270340+sgindeed@users.noreply.github.com> +Date: Sat Oct 11 14:18:34 2025 +0530 + + Add Burrows-Wheeler Transform (BWT) implementation in R (#184) + +commit 1887b9346a4e043b0e821c34fb4963fc0327bea6 +Author: Sachin Pangal <151670745+Orthodox-64@users.noreply.github.com> +Date: Thu Oct 9 03:32:13 2025 +0530 + + feat: implement Longest Increasing Subsequence algorithm in R (#169) + +commit e5f601222adb584472c8f5ccf9c1e7baebf0c6b2 +Author: Supratim <109270340+sgindeed@users.noreply.github.com> +Date: Thu Oct 9 03:01:56 2025 +0530 + + feat: Add Rabin–Karp string search algorithm in R (#166) + +commit 96737fe963113a4caa1945e0048592bc0bbf8b9e +Author: Supratim <109270340+sgindeed@users.noreply.github.com> +Date: Thu Oct 9 02:34:51 2025 +0530 + + feat: Add Minimum Window Substring algorithm in R (#165) + +commit 8c18f07eb90e5b1bd5ba595c5cbcc490e64c615c +Author: Supratim <109270340+sgindeed@users.noreply.github.com> +Date: Thu Oct 9 02:30:19 2025 +0530 + + feat: Add Longest Palindromic Subsequence algorithm in R (#164) + +commit 9e23362e429f1350e5b1a17668e3fbb7d6cfd777 +Author: Sachin Pangal <151670745+Orthodox-64@users.noreply.github.com> +Date: Thu Oct 9 02:23:38 2025 +0530 + + feat- 0/1 Knapsack Problem (Dynamic Programming) in R (#167) + +commit 72ad1cc59b8e2e3e0971ea8bf9264b3979a195d3 +Author: Supratim <109270340+sgindeed@users.noreply.github.com> +Date: Wed Oct 8 17:40:31 2025 +0530 + + feat: Add R program to find longest substring without repeating characters (#163) + +commit d408fea8e7a33d5ef39c5d2907b3d3f926a2684c +Author: Supratim <109270340+sgindeed@users.noreply.github.com> +Date: Wed Oct 8 13:06:04 2025 +0530 + + Create unique.letters.count.R (#162) + +commit cd836f75a18150fdba2ab6c92a762918679bddb8 +Author: PIYUSH KUMAR SINGH <121piyush466mits@gmail.com> +Date: Wed Oct 8 03:22:27 2025 +0530 + + Add Longest Common Subsequence (LCS) dynamic programming algorithm (#158) + +commit 365ec08676862369c69b077473d1b5ba6a1b8322 +Author: PIYUSH KUMAR SINGH <121piyush466mits@gmail.com> +Date: Mon Oct 6 22:09:05 2025 +0530 + + Add Binary Search Tree (BST) (#159) + +commit 68bc3c84a2328baa65030f3474ec168740d9e9e7 +Author: PIYUSH KUMAR SINGH <121piyush466mits@gmail.com> +Date: Mon Oct 6 02:36:34 2025 +0530 + + Add Sieve of Eratosthenes algorithm (#154) + +commit df205e73e11c94e4a2aa33db83085a9c033f5aa4 +Author: PIYUSH KUMAR SINGH <121piyush466mits@gmail.com> +Date: Mon Oct 6 02:36:00 2025 +0530 + + Add Dijkstra's shortest path algorithm (#153) + +commit b0f8ccf076a8b6c1e9e15904b6ecda9b4e684099 +Author: PIYUSH KUMAR SINGH <121piyush466mits@gmail.com> +Date: Mon Oct 6 02:34:00 2025 +0530 + + Add Breadth-First Search (BFS) (#152) + +commit b3d0b78f302dc66864af73c66a9ebdcb14b32412 +Author: PIYUSH KUMAR SINGH <121piyush466mits@gmail.com> +Date: Mon Oct 6 02:26:51 2025 +0530 + + Add Depth-First Search (DFS) algorithm (#151) + +commit 6e76d3422e584ecb1159a08eb12d7a2bdcff96b7 +Author: PIYUSH KUMAR SINGH <121piyush466mits@gmail.com> +Date: Sat Oct 4 23:43:58 2025 +0530 + + Add Extended Euclidean Algorithm (#155) + +commit 6b0fd3b5e79a4f2706fb579e391b25ba711131a1 +Author: Pradnya Ingle <146155532+Pradnyaa05@users.noreply.github.com> +Date: Sat Apr 19 18:42:09 2025 +0530 + + Update contribution guidelines (#147) + +commit 74547073b5776205d9522f776c833df9954b2684 +Author: Ifeanyi Idiaye <72707830+Ifeanyi55@users.noreply.github.com> +Date: Tue Nov 26 17:10:10 2024 +0100 + + Add maskWords.R (#144) + +commit b46d3ac3be75d6e13ee72d507924e3b10bc7ed0a +Author: Ifeanyi Idiaye <72707830+Ifeanyi55@users.noreply.github.com> +Date: Wed Nov 13 22:18:47 2024 +0100 + + Add shorten.vector.R (#143) + +commit 191af3f0e4f2f799ca095f68a91ab94cefe631cd +Author: Ifeanyi Idiaye <72707830+Ifeanyi55@users.noreply.github.com> +Date: Wed Nov 6 22:08:53 2024 +0100 + + Move findPalindrome.R to string_manipulation folder (#139) + +commit 27e2420f557d394d2679e8f8163fdfd31f7ec133 +Author: Ifeanyi Idiaye <72707830+Ifeanyi55@users.noreply.github.com> +Date: Wed Nov 6 22:08:36 2024 +0100 + + Move is.anagram.R to string_manipulation folder (#140) + +commit 91525faf60f3004170f8493226e6ce7bca327e37 +Author: Ifeanyi Idiaye <72707830+Ifeanyi55@users.noreply.github.com> +Date: Wed Nov 6 22:08:17 2024 +0100 + + Move is.lower.R to string_manipulation folder (#141) + +commit 37eb076a00448137a9f0ea42c41bb2eabfa01126 +Author: Ifeanyi Idiaye <72707830+Ifeanyi55@users.noreply.github.com> +Date: Wed Nov 6 22:07:29 2024 +0100 + + Move is.upper.R to string_manipulation folder (#142) + +commit 7ab44f65f543ef05bbccb95f4cefa21e3ae6a568 +Author: Ifeanyi Idiaye <72707830+Ifeanyi55@users.noreply.github.com> +Date: Mon Nov 4 20:41:49 2024 +0100 + + Change folder name (#138) + +commit 2a7072558072e0223f4c29651aa9075cf7c0b7b1 +Author: Simon Waldherr +Date: Tue Oct 29 21:24:58 2024 +0100 + + Add Patience Sort (#137) + +commit 5da148ecd1ab8d7416d1d15e835553211a546464 +Author: Simon Waldherr +Date: Tue Oct 29 21:24:15 2024 +0100 + + Add strand sort (#136) + +commit ad2f0963b20a8304e157d726eaf717bcc116b26a +Author: Simon Waldherr +Date: Tue Oct 29 21:23:46 2024 +0100 + + Add common divisor and common multiple (#135) + +commit acbb8d8766a9bd771129c660a3b782461a522a43 +Author: Simon Waldherr +Date: Tue Oct 29 21:23:18 2024 +0100 + + Add permutation calculation example (#134) + +commit 92324e2ed5cc174854e21d5a527632e32ba5da53 +Author: Ifeanyi Idiaye <72707830+Ifeanyi55@users.noreply.github.com> +Date: Tue Oct 29 18:38:38 2024 +0100 + + Add an algorithm for checking if a string is in lowercase (#131) + +commit c2dcaff0007bfc8f9086c2f3c00cb69b9fc473b8 +Author: Ifeanyi Idiaye <72707830+Ifeanyi55@users.noreply.github.com> +Date: Tue Oct 29 18:38:22 2024 +0100 + + Add an algorithm for checking if a string is in uppercase (#130) + +commit ce8a6948838c725d123825872ef9b2df74fe1330 +Author: Simon Waldherr +Date: Tue Oct 29 18:37:12 2024 +0100 + + Add gnome sort (#133) + +commit 64b7b70be500795a4e9b52cf72a0283cf972ae6a +Author: Ifeanyi Idiaye <72707830+Ifeanyi55@users.noreply.github.com> +Date: Fri Oct 25 15:57:35 2024 +0100 + + Add an algorithm for determining the number of possible rearrangements of a string (#129) + +commit 7f007339efcf9d01ced45960dd1a4e086e607467 +Author: Ifeanyi Idiaye <72707830+Ifeanyi55@users.noreply.github.com> +Date: Wed Oct 23 18:52:10 2024 +0100 + + Add an algorithm for checking anagrams (#128) + +commit 61eed3860d479581e3aa18abb6032538ad596c37 +Author: Ifeanyi Idiaye <72707830+Ifeanyi55@users.noreply.github.com> +Date: Wed Oct 23 11:35:50 2024 +0100 + + Add an algorithm that finds palindromes in text (#127) + +commit 898a0a1fda67fec17f579bbb7df0ebf5caf301ef +Author: Vineet Kumar <108144301+whyvineet@users.noreply.github.com> +Date: Mon Oct 7 18:29:38 2024 +0530 + + Add Tim Sort (#125) + +commit a1aeafc84a375243befd6839621fa6a392e33ec1 +Author: Akshat Sharma <111536616+Akshat111111@users.noreply.github.com> +Date: Tue Mar 12 14:35:04 2024 +0530 + + Add Monte Carlo simulation, Markowitz portfolio optimization, and Kalman filter (#123) + +commit 3ddddeec99dcffe5ae577747e6c831b2388178c1 +Author: Andrii Siriak +Date: Tue Mar 12 10:17:13 2024 +0200 + + Remove outdated documentation by fixing documentation_workflow.yml (#121) + +commit 8381a8d6a06ae9d4f48cd69f8d3ab11607893772 +Author: Rohit Chaudhari <100275369+rohitkbc@users.noreply.github.com> +Date: Sun Nov 19 15:12:46 2023 +0530 + + Add Gitpod (#119) + +commit 348c099e5b9d1a4245e8d33655af212b694af04d +Author: Saurav <91366385+Saurav-IIITU@users.noreply.github.com> +Date: Fri Nov 3 18:37:43 2023 +0530 + + Add topological sort (#117) + +commit 1c7e4a23522149e74bc45971f074849f451b496e +Author: Riya Khandelwal <114740796+Khandelwal05@users.noreply.github.com> +Date: Sat Oct 14 18:48:58 2023 +0530 + + Add cocktail_sort.r (#114) + +commit 8beb87a6c3c0251083c63b1553d8de749d2feaf3 +Author: paras-2407 <131509174+paras-2407@users.noreply.github.com> +Date: Wed Oct 11 01:47:32 2023 +0530 + + Update directory.md (#112) + +commit f5056677ece79ee39be8c14b3b20d5fa6a9a4ef9 +Author: paras-2407 <131509174+paras-2407@users.noreply.github.com> +Date: Mon Oct 9 21:02:46 2023 +0530 + + Add binary_search.r (fixes #107) (#108) + +commit 4f35b315fa16c10fe93246aa1385913e9f66ff84 +Author: paras-2407 <131509174+paras-2407@users.noreply.github.com> +Date: Sun Oct 8 00:45:13 2023 +0530 + + Add linear_search.r (#106) + +commit 74b05246256de287702e5ea2385fc7c877bd24de +Author: iMeet07 <97329296+iMeet07@users.noreply.github.com> +Date: Fri Oct 6 22:28:14 2023 +0530 + + Add pancake_sort (#101) + +commit bd0cb3348d3d1ea46e8aedd8bd2fb4dedab44848 +Author: iMeet07 <97329296+iMeet07@users.noreply.github.com> +Date: Fri Oct 6 22:26:00 2023 +0530 + + Add shell_sort (#102) + +commit 07a1c231cb5a2e1cdc9b2d6940d68598b3fc5e0f +Author: iMeet07 <97329296+iMeet07@users.noreply.github.com> +Date: Thu Oct 5 19:08:27 2023 +0530 + + Add wiggle sort (#97) + +commit d73ef9dfc5a891af14b10ce7ee7b057938b051bb +Author: iMeet07 <97329296+iMeet07@users.noreply.github.com> +Date: Thu Oct 5 19:05:40 2023 +0530 + + Add binary_insertion_sort.r (#95) + +commit bc04a424bdf93b96feb0a0a8c94f70c2205eb9ca +Author: BSzmolke <40246238+BSzmolke@users.noreply.github.com> +Date: Mon May 29 13:25:30 2023 +0200 + + Add amicable number checker (#92) diff --git a/graph_algorithms/bidirectional_bfs.r b/graph_algorithms/bidirectional_bfs.r new file mode 100644 index 00000000..6d070a9d --- /dev/null +++ b/graph_algorithms/bidirectional_bfs.r @@ -0,0 +1,154 @@ +# ============================================================== +# Bidirectional Breadth-First Search (BFS) Shortest Path Algorithm +# ============================================================== +# +# Description: +# Finds the shortest path between a source and target in an +# unweighted graph using Bidirectional BFS. +# +# Time Complexity: O(b^(d/2)) — much faster than normal BFS O(b^d) +# Space Complexity: O(V) +# +# Input: +# graph - adjacency list (list of integer vectors) +# source - integer (starting vertex) +# target - integer (destination vertex) +# +# Output: +# A list containing: +# path - vector of vertices representing the path +# distance - number of edges in the shortest path +# found - logical flag (TRUE if path found, else FALSE) +# +# Example usage at bottom of file. +# ============================================================== + +bidirectional_bfs <- function(graph, source, target) { + if (source == target) { + return(list(path = c(source), distance = 0, found = TRUE)) + } + + # Initialize BFS from both ends + visited_from_source <- setNames(rep(FALSE, length(graph)), names(graph)) + visited_from_target <- setNames(rep(FALSE, length(graph)), names(graph)) + + parent_from_source <- rep(NA, length(graph)) + parent_from_target <- rep(NA, length(graph)) + + queue_source <- c(source) + queue_target <- c(target) + + visited_from_source[source] <- TRUE + visited_from_target[target] <- TRUE + + meeting_node <- NA + + # Function to check intersection + get_intersection <- function() { + common <- which(visited_from_source & visited_from_target) + if (length(common) > 0) return(common[1]) + return(NA) + } + + # Main loop + while (length(queue_source) > 0 && length(queue_target) > 0) { + # Expand one level from source side + next_queue_list <- list() + idx <- 1 + for (u in queue_source) { + for (v in graph[[as.character(u)]]) { + if (!visited_from_source[v]) { + visited_from_source[v] <- TRUE + parent_from_source[v] <- u + next_queue_list[[idx]] <- v + idx <- idx + 1 + } + } + } + queue_source <- unlist(next_queue_list, use.names = FALSE) + + # Check intersection + meeting_node <- get_intersection() + if (!is.na(meeting_node)) break + + # Expand one level from target side + next_queue_list <- list() + idx <- 1 + for (u in queue_target) { + for (v in graph[[as.character(u)]]) { + if (!visited_from_target[v]) { + visited_from_target[v] <- TRUE + parent_from_target[v] <- u + next_queue_list[[idx]] <- v + idx <- idx + 1 + } + } + } + queue_target <- unlist(next_queue_list, use.names = FALSE) + + # Check intersection again + meeting_node <- get_intersection() + if (!is.na(meeting_node)) break + } + + if (is.na(meeting_node)) { + return(list(path = NULL, distance = Inf, found = FALSE)) + } + + # Reconstruct path from source → meeting_node + path1 <- c() + node <- meeting_node + while (!is.na(node)) { + path1 <- c(node, path1) + node <- parent_from_source[node] + } + + # Reconstruct path from meeting_node → target + path2 <- c() + node <- parent_from_target[meeting_node] + while (!is.na(node)) { + path2 <- c(path2, node) + node <- parent_from_target[node] + } + + full_path <- c(path1, path2) + return(list(path = full_path, distance = length(full_path) - 1, found = TRUE)) +} + +# ============================================================== +# Example Usage and Test +# ============================================================== + +if (interactive()) { + cat("=== Bidirectional BFS Shortest Path ===\n") + + # Example Graph (Unweighted) + # 1 -- 2 -- 3 + # | | + # 4 -- 5 -- 6 + + graph <- list( + "1" = c(2, 4), + "2" = c(1, 3, 5), + "3" = c(2, 6), + "4" = c(1, 5), + "5" = c(2, 4, 6), + "6" = c(3, 5) + ) + + cat("Graph adjacency list:\n") + for (v in names(graph)) { + cat("Vertex", v, "-> [", paste(graph[[v]], collapse = ", "), "]\n") + } + + cat("\nRunning Bidirectional BFS from 1 to 6...\n") + result <- bidirectional_bfs(graph, 1, 6) + + if (result$found) { + cat("Shortest Path Found!\n") + cat("Path:", paste(result$path, collapse = " -> "), "\n") + cat("Distance:", result$distance, "\n") + } else { + cat("No path found between source and target.\n") + } +} \ No newline at end of file diff --git a/graph_algorithms/graph_coloring.r b/graph_algorithms/graph_coloring.r new file mode 100644 index 00000000..3210c8c2 --- /dev/null +++ b/graph_algorithms/graph_coloring.r @@ -0,0 +1,256 @@ +# Graph Coloring Algorithm using Backtracking +# +# The graph coloring problem involves assigning colors to vertices of a graph such that +# no two adjacent vertices share the same color. This implementation uses backtracking +# to find a valid coloring with a given number of colors. +# +# Time Complexity: O(m^V) where m is number of colors and V is number of vertices +# Space Complexity: O(V) for recursion stack and color assignment array +# +# Input: graph as adjacency matrix (n x n), number of colors +# Output: A list with fields: +# - success: TRUE if a valid coloring was found, FALSE otherwise +# - colors: integer vector of color assignments for each vertex (or NULL if not successful) +# - num_colors_used: number of colors used (or NULL if not successful) + +graph_coloring <- function(graph, num_colors) { + n <- nrow(graph) + colors <- rep(0, n) + + # Check if color assignment is safe for vertex v + is_safe <- function(v, c) { + for (i in 1:n) { + if (graph[v, i] == 1 && colors[i] == c) { + return(FALSE) + } + } + return(TRUE) + } + + # Backtracking function to color vertices + color_vertex <- function(v) { + if (v > n) { + return(TRUE) + } + + for (c in 1:num_colors) { + if (is_safe(v, c)) { + colors[v] <<- c + + if (color_vertex(v + 1)) { + return(TRUE) + } + + colors[v] <<- 0 + } + } + + return(FALSE) + } + + if (color_vertex(1)) { + return(list( + success = TRUE, + colors = colors, + num_colors_used = max(colors) + )) + } else { + return(list( + success = FALSE, + colors = NULL, + num_colors_used = NULL + )) + } +} + +# Find chromatic number (minimum colors needed) +find_chromatic_number <- function(graph) { + n <- nrow(graph) + + for (num_colors in 1:n) { + result <- graph_coloring(graph, num_colors) + if (result$success) { + return(num_colors) + } + } + + return(n) +} + +# Greedy graph coloring (faster but not always optimal) +greedy_coloring <- function(graph) { + n <- nrow(graph) + colors <- rep(0, n) + + for (v in 1:n) { + available <- rep(TRUE, n) + + for (i in 1:n) { + if (graph[v, i] == 1 && colors[i] != 0) { + available[colors[i]] <- FALSE + } + } + + for (c in 1:n) { + if (available[c]) { + colors[v] <- c + break + } + } + } + + num_colors_used <- max(colors) + + return(list( + colors = colors, + num_colors_used = num_colors_used + )) +} + +# Welsh-Powell algorithm (colors vertices in descending degree order) +welsh_powell_coloring <- function(graph) { + n <- nrow(graph) + degrees <- rowSums(graph) + vertex_order <- order(degrees, decreasing = TRUE) + + colors <- rep(0, n) + + for (v in vertex_order) { + available <- rep(TRUE, n + 1) + + for (i in 1:n) { + if (graph[v, i] == 1 && colors[i] != 0) { + available[colors[i]] <- FALSE + } + } + + for (c in 1:(n + 1)) { + if (available[c]) { + colors[v] <- c + break + } + } + } + + num_colors_used <- max(colors) + + return(list( + colors = colors, + num_colors_used = num_colors_used + )) +} + +# Validate coloring solution +validate_coloring <- function(graph, colors) { + n <- nrow(graph) + + for (i in 1:(n - 1)) { + for (j in (i + 1):n) { + if (graph[i, j] == 1 && colors[i] == colors[j]) { + return(FALSE) + } + } + } + + return(TRUE) +} + +# Example usage and tests +if (interactive()) { + cat("=== Graph Coloring Algorithm ===\n\n") + + # Example 1: Simple triangle graph (needs 3 colors) + cat("Example 1: Triangle Graph\n") + triangle <- matrix(c( + 0, 1, 1, + 1, 0, 1, + 1, 1, 0 + ), nrow = 3, byrow = TRUE) + + cat("Adjacency Matrix:\n") + print(triangle) + + result1 <- graph_coloring(triangle, 3) + cat("\nBacktracking with 3 colors:\n") + cat("Success:", result1$success, "\n") + cat("Color assignment:", result1$colors, "\n") + cat("Valid:", validate_coloring(triangle, result1$colors), "\n") + + result1_fail <- graph_coloring(triangle, 2) + cat("\nBacktracking with 2 colors:\n") + cat("Success:", result1_fail$success, "\n") + + # Example 2: Petersen graph (chromatic number = 3) + cat("\n\nExample 2: Petersen Graph (10 vertices)\n") + petersen <- matrix(0, nrow = 10, ncol = 10) + edges <- list( + c(1, 2), c(2, 3), c(3, 4), c(4, 5), c(5, 1), + c(1, 6), c(2, 7), c(3, 8), c(4, 9), c(5, 10), + c(6, 8), c(8, 10), c(10, 7), c(7, 9), c(9, 6) + ) + for (edge in edges) { + petersen[edge[1], edge[2]] <- 1 + petersen[edge[2], edge[1]] <- 1 + } + + cat("Finding chromatic number...\n") + chromatic_num <- find_chromatic_number(petersen) + cat("Chromatic number:", chromatic_num, "\n") + + result2 <- graph_coloring(petersen, chromatic_num) + cat("Color assignment:", result2$colors, "\n") + cat("Valid:", validate_coloring(petersen, result2$colors), "\n") + + # Example 3: Bipartite graph (needs 2 colors) + cat("\n\nExample 3: Bipartite Graph K(3,3)\n") + bipartite <- matrix(c( + 0, 0, 0, 1, 1, 1, + 0, 0, 0, 1, 1, 1, + 0, 0, 0, 1, 1, 1, + 1, 1, 1, 0, 0, 0, + 1, 1, 1, 0, 0, 0, + 1, 1, 1, 0, 0, 0 + ), nrow = 6, byrow = TRUE) + + result3 <- graph_coloring(bipartite, 2) + cat("Backtracking with 2 colors:\n") + cat("Success:", result3$success, "\n") + cat("Color assignment:", result3$colors, "\n") + cat("Valid:", validate_coloring(bipartite, result3$colors), "\n") + + # Example 4: Compare algorithms + cat("\n\nExample 4: Algorithm Comparison on Random Graph\n") + set.seed(42) + n <- 8 + random_graph <- matrix(0, nrow = n, ncol = n) + for (i in 1:(n-1)) { + for (j in (i+1):n) { + if (runif(1) < 0.3) { + random_graph[i, j] <- 1 + random_graph[j, i] <- 1 + } + } + } + + cat("Graph size:", n, "vertices\n") + cat("Number of edges:", sum(random_graph) / 2, "\n\n") + + greedy_result <- greedy_coloring(random_graph) + cat("Greedy Coloring:\n") + cat("Colors used:", greedy_result$num_colors_used, "\n") + cat("Color assignment:", greedy_result$colors, "\n") + cat("Valid:", validate_coloring(random_graph, greedy_result$colors), "\n\n") + + wp_result <- welsh_powell_coloring(random_graph) + cat("Welsh-Powell Coloring:\n") + cat("Colors used:", wp_result$num_colors_used, "\n") + cat("Color assignment:", wp_result$colors, "\n") + cat("Valid:", validate_coloring(random_graph, wp_result$colors), "\n\n") + + chromatic <- find_chromatic_number(random_graph) + cat("Optimal (Backtracking):\n") + cat("Chromatic number:", chromatic, "\n") + + optimal_result <- graph_coloring(random_graph, chromatic) + cat("Color assignment:", optimal_result$colors, "\n") + cat("Valid:", validate_coloring(random_graph, optimal_result$colors), "\n")