|
| 1 | +# Bitonic sort in R: |
| 2 | + |
| 3 | +# This implementation follows the style used across this repository: a single exported |
| 4 | +# function with a commented example at the bottom. Bitonic sort is typically defined |
| 5 | +# for sequences with length as a power of two. For convenience, we handle arbitrary |
| 6 | +# lengths by padding with +Inf (for ascending) or -Inf (for descending) and removing |
| 7 | +# the padding before returning. |
| 8 | + |
| 9 | +# Helper to perform the bitonic compare and swap across a segment |
| 10 | +.bitonic_compare_swap <- function(a, low, cnt, asc = TRUE) { |
| 11 | + if (cnt <= 1) return(a) |
| 12 | + k <- cnt %/% 2 |
| 13 | + idx <- seq.int(low, length.out = k) |
| 14 | + partner <- idx + k |
| 15 | + if (asc) { |
| 16 | + swap <- a[idx] > a[partner] |
| 17 | + } else { |
| 18 | + swap <- a[idx] < a[partner] |
| 19 | + } |
| 20 | + if (any(swap)) { |
| 21 | + tmp <- a[idx[swap]] |
| 22 | + a[idx[swap]] <- a[partner[swap]] |
| 23 | + a[partner[swap]] <- tmp |
| 24 | + } |
| 25 | + # Recurse on both halves |
| 26 | + a <- .bitonic_compare_swap(a, low, k, asc) |
| 27 | + a <- .bitonic_compare_swap(a, low + k, k, asc) |
| 28 | + return(a) |
| 29 | +} |
| 30 | + |
| 31 | +# Core recursive builder of a bitonic sequence followed by merge |
| 32 | +.bitonic_sort_core <- function(a, low, cnt, asc = TRUE) { |
| 33 | + if (cnt <= 1) return(a) |
| 34 | + k <- cnt %/% 2 |
| 35 | + # Sort first half ascending, second half descending to form bitonic sequence |
| 36 | + a <- .bitonic_sort_core(a, low, k, TRUE) |
| 37 | + a <- .bitonic_sort_core(a, low + k, k, FALSE) |
| 38 | + # Merge whole sequence in desired direction |
| 39 | + a <- .bitonic_compare_swap(a, low, cnt, asc) |
| 40 | + return(a) |
| 41 | +} |
| 42 | + |
| 43 | +# Public API: bitonic.sort |
| 44 | +# - elements.vec: numeric or comparable vector |
| 45 | +# - ascending: TRUE for increasing order, FALSE for decreasing |
| 46 | +bitonic.sort <- function(elements.vec, ascending = TRUE) { |
| 47 | + n <- length(elements.vec) |
| 48 | + if (n <= 1) return(elements.vec) |
| 49 | + |
| 50 | + # Determine next power of two |
| 51 | + next_pow2 <- 1L |
| 52 | + while (next_pow2 < n) next_pow2 <- next_pow2 * 2L |
| 53 | + |
| 54 | + # Pad to power of two for algorithmic convenience |
| 55 | + pad_len <- next_pow2 - n |
| 56 | + if (pad_len > 0) { |
| 57 | + pad_val <- if (ascending) Inf else -Inf |
| 58 | + a <- c(elements.vec, rep(pad_val, pad_len)) |
| 59 | + } else { |
| 60 | + a <- elements.vec |
| 61 | + } |
| 62 | + |
| 63 | + a <- .bitonic_sort_core(a, 1L, length(a), asc = ascending) |
| 64 | + |
| 65 | + # Trim padding if any |
| 66 | + if (pad_len > 0) { |
| 67 | + a <- a[seq_len(n)] |
| 68 | + } |
| 69 | + return(a) |
| 70 | +} |
| 71 | + |
| 72 | +# Example: |
| 73 | +# bitonic.sort(c(3, 7, 4, 8, 6, 2, 1, 5)) |
| 74 | +# [1] 1 2 3 4 5 6 7 8 |
| 75 | +# bitonic.sort(c(3, 7, 4, 8, 6, 2, 1, 5), ascending = FALSE) |
| 76 | +# [1] 8 7 6 5 4 3 2 1 |
0 commit comments