Every problem

BA1A — Compute the Number of Times a Pattern Appears in a Text

solvedbrowser + CLI Problem statement Open in the workbench Download .bl

# Rosalind: BA1A — Compute the Number of Times a Pattern Appears in a Text
# https://rosalind.info/problems/ba1a/
#
# Given: Strings Text and Pattern.
# Return: Count(Text, Pattern), counting overlapping occurrences.

let text = "GCGCG"
let pattern = "GCG"

# find_motif reports every start position, overlaps included, so the count is
# just its length.
let result = len(find_motif(text, pattern))

println("Result:   " + str(result))
println("Expected: 2")

fn test_ba1a_pattern_count() {
    assert result == 2, "BA1A: got " + str(result)
}

BA1B — Find the Most Frequent Words in a String

solvedbrowser + CLI Problem statement Open in the workbench Download .bl

Shows a real distinction: kmer_count() tallies canonical k-mers, pooling each with its reverse complement, so it reports GCAT and ATGC as one count of 4. This problem wants literal occurrences, so it counts the raw windows from kmers().

# Rosalind: BA1B — Find the Most Frequent Words in a String
# https://rosalind.info/problems/ba1b/
#
# Given: A DNA string Text and an integer k.
# Return: Every most frequent k-mer in Text.

let text = "ACGTTGCATGTCGCATGATGCATGAGAGCT"
let k = 4

# Deliberately not kmer_count(): that tallies *canonical* k-mers, pooling each
# one with its reverse complement, which is what you want when the strand is
# unknown. Here GCAT and ATGC would merge into a single count of 4, while this
# problem asks for literal occurrences. kmers() gives the raw windows.
let window_list = kmers(dna(text), k) |> map(|km| str(km))
let distinct_count = window_list |> unique()

let tallies = distinct_count |> map(|km| { kmer: km, count: window_list |> count_if(|w| w == km) })
let best = tallies |> map(|e| e.count) |> max()
let result = tallies |> filter(|e| e.count == best) |> map(|e| e.kmer) |> sort()

println("Result:   " + (result |> join(" ")) + "  (each appearing " + str(best) + " times)")
println("Expected: CATG GCAT")

fn test_ba1b_most_frequent_words() {
    assert len(result) == 2, "BA1B: got " + str(len(result)) + " k-mers"
    assert result |> contains("CATG"), "BA1B: missing CATG"
    assert result |> contains("GCAT"), "BA1B: missing GCAT"
    assert best == 3, "BA1B: top count was " + str(best)
    # Every window is counted exactly once.
    let total = tallies |> map(|e| e.count) |> sum()
    assert total == len(text) - k + 1, "BA1B: counts total " + str(total)
}

BA1C — Find the Reverse Complement of a String

solvedbrowser + CLI Problem statement Open in the workbench Download .bl

# Rosalind: BA1C — Find the Reverse Complement of a String
# https://rosalind.info/problems/ba1c/
#
# Given: A DNA string Pattern.
# Return: The reverse complement of Pattern.

let pattern = dna"AAAACCCGGT"

let result = str(reverse_complement(pattern))

println("Result:   " + result)
println("Expected: ACCGGGTTTT")

fn test_ba1c_reverse_complement() {
    assert result == "ACCGGGTTTT", "BA1C: got " + result
}

BA1D — Find All Occurrences of a Pattern in a String

solvedbrowser + CLI Problem statement Open in the workbench Download .bl

# Rosalind: BA1D — Find All Occurrences of a Pattern in a String
# https://rosalind.info/problems/ba1d/
#
# Given: Strings Pattern and Genome.
# Return: Every starting position where Pattern appears, zero-based.

let pattern = "ATAT"
let genome_text = "GATATATGCATATACTT"

let positions = find_motif(genome_text, pattern)
let result = positions |> map(|p| str(p)) |> join(" ")

println("Result:   " + result)
println("Expected: 1 3 9")

fn test_ba1d_pattern_positions() {
    assert result == "1 3 9", "BA1D: got '" + result + "'"
}

BA1G — Compute the Hamming Distance Between Two Strings

solvedbrowser + CLI Problem statement Open in the workbench Download .bl

# Rosalind: BA1G — Compute the Hamming Distance Between Two Strings
# https://rosalind.info/problems/ba1g/
#
# Given: Two strings of equal length.
# Return: Their Hamming distance.

let p = "GGGCCGTTGGT"
let q = "GGACCGTTGAC"

let result = hamming_distance(p, q)

println("Result:   " + str(result))
println("Expected: 3")

fn test_ba1g_hamming_distance() {
    assert result == 3, "BA1G: got " + str(result)
}

BA3A — Generate the k-mer Composition of a String

solvedbrowser + CLI Problem statement Open in the workbench Download .bl

# Rosalind: BA3A — Generate the k-mer Composition of a String
# https://rosalind.info/problems/ba3a/
#
# Given: An integer k and a string Text.
# Return: Composition_k(Text), the k-mers of Text in lexicographic order.

let text = "CAATCCAAC"
let k = 5

let result = kmers(dna(text), k) |> map(|km| str(km)) |> sort()

println("Result:")
result |> each(|km| println("  " + km))
println("Expected: AATCC ATCCA CAATC CCAAC TCCAA")

fn test_ba3a_kmer_composition() {
    assert len(result) == len(text) - k + 1, "BA3A: got " + str(len(result)) + " k-mers"
    let joined = result |> join(" ")
    assert joined == "AATCC ATCCA CAATC CCAAC TCCAA", "BA3A: got " + joined
}

BA4A — Translate an RNA String into an Amino Acid String

solvedbrowser + CLI Problem statement Open in the workbench Download .bl

# Rosalind: BA4A — Translate an RNA String into an Amino Acid String
# https://rosalind.info/problems/ba4a/
#
# Given: An RNA string Pattern.
# Return: The translation of Pattern into an amino acid string.

let pattern = rna"AUGGCCAUGGCGCCCAGAACUGAGAUCAAUAGUACCCGUAUUAACGGGUGA"

let result = str(translate(pattern))

println("Result:   " + result)
println("Expected: MAMAPRTEINSTRING")

fn test_ba4a_translation() {
    assert result == "MAMAPRTEINSTRING", "BA4A: got " + result
}

BA5G — Compute the Edit Distance Between Two Strings

solvedbrowser + CLI Problem statement Open in the workbench Download .bl

# Rosalind: BA5G — Compute the Edit Distance Between Two Strings
# https://rosalind.info/problems/ba5g/
#
# Given: Two amino acid strings.
# Return: The edit distance between them.

let s = "PLEASANTLY"
let t = "MEANLY"

let result = edit_distance(s, t)

println("Result:   " + str(result))
println("Expected: 5")

fn test_ba5g_edit_distance() {
    assert result == 5, "BA5G: got " + str(result)
}

BA9G — Construct the Suffix Array of a String

solvedbrowser + CLI Problem statement Open in the workbench Download .bl

Suffix arrays were one of three gaps this pack was built to measure. They are a builtin now, which is what LREP and MREP in the Stronghold pack stand on.

# Rosalind: BA9G — Construct the Suffix Array of a String
# https://rosalind.info/problems/ba9g/
#
# Given: A string Text.
# Return: SuffixArray(Text) — the starting positions of its suffixes, in the
# order those suffixes sort.

let text = "AACGATAGCGGTAGA$"

# The `$` is part of the input, not something the builtin adds. It sorts before
# every letter, so the empty-ish final suffix comes first, and it stops any
# suffix from being a prefix of another — which is what makes the order total.
let sa = suffix_array(text)

let result = sa |> map(|i| str(i)) |> join(", ")

println("Result:   " + result)
println("Expected: 15, 14, 0, 1, 12, 6, 4, 2, 8, 13, 3, 7, 9, 10, 11, 5")

fn test_ba9g_suffix_array() {
    assert result == "15, 14, 0, 1, 12, 6, 4, 2, 8, 13, 3, 7, 9, 10, 11, 5",
        "BA9G: got " + result
    # Every position appears exactly once, and the suffixes really are in order.
    assert len(unique(sa)) == len(text), "BA9G: a position is repeated or missing"
    let out_of_order = range(1, len(sa))
        |> filter(|i| substr(text, sa[i - 1], len(text) - sa[i - 1])
                    > substr(text, sa[i], len(text) - sa[i]))
    assert len(out_of_order) == 0, "BA9G: suffixes out of order at " + str(out_of_order)
}

BA1E — Find Patterns Forming Clumps in a String

solvedbrowser + CLI Problem statement Open in the workbench Download .bl

A sliding window with a tally inside it. A k-mer qualifies once, so the answers are a set.

# Rosalind: BA1E — Find Patterns Forming Clumps in a String
# https://rosalind.info/problems/ba1e/
#
# Given: A string Genome, and integers k, L and t.
# Return: All distinct k-mers forming (L, t)-clumps in Genome.

let sequence = "CGGACTCGACAGATGTGAAGAAATGTGAAGACTGAGTGAAGAGAAGAGGAAACACGACACGACATTGCGACATAATGTACGAATGTAATGTGCCTATGGC"
let k = 5
let span = 75
let times = 4

# A k-mer forms a clump when some window of L characters contains it t times.
# Slide the window and tally what is inside it; a k-mer only needs to qualify
# once, so the answers are collected as a set.
let found = []
for start in range(0, len(sequence) - span + 1) {
    let region = substr(sequence, start, span)
    let counts = {}
    for offset in range(0, span - k + 1) {
        let mer = substr(region, offset, k)
        if contains(keys(counts), mer) {
            counts[mer] = counts[mer] + 1
        } else {
            counts[mer] = 1
        }
    }
    for mer in keys(counts) {
        if counts[mer] >= times and contains(found, mer) == false {
            found = push(found, mer)
        }
    }
}

let result = sort(found) |> join(" ")

println("Result:   " + result)
println("Expected: AATGT CGACA GAAGA  (in any order)")

fn test_ba1e_clumps() {
    assert len(found) == 3, "BA1E: expected 3 clumps, got " + str(len(found))
    for expected in ["CGACA", "GAAGA", "AATGT"] {
        assert contains(found, expected), "BA1E: missing " + expected
    }
}

BA1F — Find a Position in a Genome Minimizing the Skew

solvedbrowser + CLI Problem statement Open in the workbench Download .bl

A running count of G minus C. The dip marks the replication origin, which is what the problem is about.

# Rosalind: BA1F — Find a Position in a Genome Minimizing the Skew
# https://rosalind.info/problems/ba1f/
#
# Given: A DNA string Genome.
# Return: All integers i minimising Skew(Prefix_i(Genome)).

let sequence = "CCTATCGGTGGATTAGCATGTCCCTGTACGTTTCGCCGCGAACTAGTTCACACGGCTTGATGGCAAATGGTTTTTCCGGCGACCGTAATCGTCCACCGAG"

# Skew is running #G minus #C. It dips lowest near the replication origin, which
# is what the problem is really about. Prefix 0 is the empty prefix, so the walk
# has len(genome) + 1 positions.
let skew = [0]
let running = 0
for i in range(0, len(sequence)) {
    let base = substr(sequence, i, 1)
    if base == "G" then running = running + 1
    if base == "C" then running = running - 1
    skew = push(skew, running)
}

let lowest = min(skew)
let positions = range(0, len(skew)) |> filter(|i| skew[i] == lowest)
let result = positions |> map(|i| str(i)) |> join(" ")

println("Result:   " + result)
println("Expected: 53 97")

fn test_ba1f_minimum_skew() {
    assert result == "53 97", "BA1F: got " + result
}

BA1H — Find All Approximate Occurrences of a Pattern

solvedbrowser + CLI Problem statement Open in the workbench Download .bl

hamming_distance is a builtin, so this is a windowed scan and nothing more.

# Rosalind: BA1H — Find All Approximate Occurrences of a Pattern in a String
# https://rosalind.info/problems/ba1h/
#
# Given: Strings Pattern and Text, and an integer d.
# Return: All starting positions where Pattern occurs in Text with at most d
# mismatches.

let pattern = "ATTCTGGA"
let text = "CGCCCGAATCCAGAACGCATTCCCATATTTCGGGACCACTGGCCTCCACGGTACGGACGTCAATCAAATGCCTAGCGGCTTGTGGTTTCTCCTACGCTCC"
let allowed = 3

# hamming_distance is a builtin, so the whole problem is a windowed scan: every
# position whose window is within d substitutions of the pattern.
let positions = range(0, len(text) - len(pattern) + 1)
  |> filter(|i| hamming_distance(substr(text, i, len(pattern)), pattern) <= allowed)

let result = positions |> map(|i| str(i)) |> join(" ")

println("Result:   " + result)
println("Expected: 6 7 26 27 78")

fn test_ba1h_approximate_matches() {
    assert result == "6 7 26 27 78", "BA1H: got " + result
}

BA1I — Most Frequent Words with Mismatches

solvedbrowser + CLI Problem statement Open in the workbench Download .bl

The answer need not occur in the text at all. Tallying each window's neighbourhood is the same arithmetic over far fewer strings than testing all 4^k candidates.

# Rosalind: BA1I — Find the Most Frequent Words with Mismatches in a String
# https://rosalind.info/problems/ba1i/
#
# Given: A string Text and integers k and d.
# Return: All most frequent k-mers with up to d mismatches in Text.

let text = "ACGTTGCATGTCGCATGATGCATGAGAGCT"
let k = 4
let d = 1

# A k-mer's count here includes every window within d substitutions of it, so
# the answer need not appear in Text at all. Rather than test every one of the
# 4^k candidates, tally the neighbourhood of each window: the same arithmetic,
# over far fewer strings.
fn neighbourhood(pattern, allowed) {
    let bases = ["A", "C", "G", "T"]
    let partial = [{ prefix: "", used: 0 }]
    for i in range(0, len(pattern)) {
        let here = substr(pattern, i, 1)
        let next = []
        for candidate in partial {
            for base in bases {
                let cost = if base == here then 0 else 1
                if candidate.used + cost <= allowed {
                    next = push(next, { prefix: candidate.prefix + base, used: candidate.used + cost })
                }
            }
        }
        partial = next
    }
    partial |> map(|c| c.prefix)
}

let counts = {}
for i in range(0, len(text) - k + 1) {
    for neighbour in neighbourhood(substr(text, i, k), d) {
        if contains(keys(counts), neighbour) {
            counts[neighbour] = counts[neighbour] + 1
        } else {
            counts[neighbour] = 1
        }
    }
}

let best = keys(counts) |> map(|mer| counts[mer]) |> max()
let winners = keys(counts) |> filter(|mer| counts[mer] == best) |> sort()

println("Result:   " + (winners |> join(" ")) + "   (each seen " + str(best) + " times)")
println("Expected: ATGC ATGT GATG  (in any order)")

fn test_ba1i_frequent_words_with_mismatches() {
    assert len(winners) == 3, "BA1I: expected 3 winners, got " + str(len(winners))
    for expected in ["GATG", "ATGC", "ATGT"] {
        assert contains(winners, expected), "BA1I: missing " + expected
    }
}

BA1J — Frequent Words with Mismatches and Reverse Complements

solvedbrowser + CLI Problem statement Open in the workbench Download .bl

A site can sit on either strand, so a k-mer is credited for its reverse complement too — which is why the winners differ from BA1I on the same input.

# Rosalind: BA1J — Find Frequent Words with Mismatches and Reverse Complements
# https://rosalind.info/problems/ba1j/
#
# Given: A DNA string Text and integers k and d.
# Return: All k-mers maximising Count_d(Text, Pattern) + Count_d(Text, revc(Pattern)).

let text = "ACGTTGCATGTCGCATGATGCATGAGAGCT"
let k = 4
let d = 1

# Same tally as BA1I, but a k-mer is credited for its reverse complement too:
# a binding site can sit on either strand, and the counts belong together. That
# is why the winners here differ from BA1I's on the same input.
fn neighbourhood(pattern, allowed) {
    let bases = ["A", "C", "G", "T"]
    let partial = [{ prefix: "", used: 0 }]
    for i in range(0, len(pattern)) {
        let here = substr(pattern, i, 1)
        let next = []
        for candidate in partial {
            for base in bases {
                let cost = if base == here then 0 else 1
                if candidate.used + cost <= allowed {
                    next = push(next, { prefix: candidate.prefix + base, used: candidate.used + cost })
                }
            }
        }
        partial = next
    }
    partial |> map(|c| c.prefix)
}

let counts = {}
for i in range(0, len(text) - k + 1) {
    for neighbour in neighbourhood(substr(text, i, k), d) {
        if contains(keys(counts), neighbour) {
            counts[neighbour] = counts[neighbour] + 1
        } else {
            counts[neighbour] = 1
        }
    }
}

# Score each candidate together with its reverse complement.
fn tally(mer) {
    if contains(keys(counts), mer) then counts[mer] else 0
}

let candidates = keys(counts)
let scores = candidates |> map(|mer| tally(mer) + tally(str(reverse_complement(dna(mer)))))
let best = max(scores)
let winners = range(0, len(candidates))
  |> filter(|i| scores[i] == best)
  |> map(|i| candidates[i])
  |> sort()

println("Result:   " + (winners |> join(" ")) + "   (scoring " + str(best) + ")")
println("Expected: ACAT ATGT  (in any order)")

fn test_ba1j_with_reverse_complements() {
    assert len(winners) == 2, "BA1J: expected 2 winners, got " + str(len(winners))
    for expected in ["ATGT", "ACAT"] {
        assert contains(winners, expected), "BA1J: missing " + expected
    }
    # The two answers are each other's reverse complement, which is the point.
    assert str(reverse_complement(dna(winners[0]))) == winners[1],
        "BA1J: the winners should be a reverse-complement pair"
}

BA1K — Generate the Frequency Array of a String

solvedbrowser + CLI Problem statement Open in the workbench Download .bl

Indexed by PatternToNumber, so it lists every possible k-mer including those that never occur. That is what separates it from a tally.

# Rosalind: BA1K — Generate the Frequency Array of a String
# https://rosalind.info/problems/ba1k/
#
# Given: A DNA string Text and an integer k.
# Return: The frequency array of k-mers in Text.

let text = "ACGCGGCTCTGAAA"
let k = 2

# The frequency array is indexed by PatternToNumber, so it has 4^k entries and
# lists every possible k-mer in lexicographic order — including the ones that
# never occur, which is what distinguishes it from a tally.
fn base_of(symbol) {
    if symbol == "A" then 0
    else if symbol == "C" then 1
    else if symbol == "G" then 2
    else 3
}

fn pattern_to_number(pattern) {
    range(0, len(pattern)) |> reduce(|acc, i| acc * 4 + base_of(substr(pattern, i, 1)), 0)
}

let size = 1
let e = 0
while e < k {
    size = size * 4
    e = e + 1
}

let freq_array = repeat([0], size)
for i in range(0, len(text) - k + 1) {
    let index = pattern_to_number(substr(text, i, k))
    freq_array[index] = freq_array[index] + 1
}

let result = freq_array |> map(|n| str(n)) |> join(" ")

println("Result:   " + result)
println("Expected: 2 1 0 0 0 0 2 2 1 2 1 0 0 1 1 0")

fn test_ba1k_frequency_array() {
    assert result == "2 1 0 0 0 0 2 2 1 2 1 0 0 1 1 0", "BA1K: got " + result
    assert len(freq_array) == 16, "BA1K: an array of 4^k entries is expected"
    assert sum(freq_array) == len(text) - k + 1, "BA1K: counts do not add up to the windows"
}

BA1L — Implement PatternToNumber

solvedbrowser + CLI Problem statement Open in the workbench Download .bl

k-mers in lexicographic order are the base-4 numbers with A=0, C=1, G=2, T=3.

# Rosalind: BA1L — Implement PatternToNumber
# https://rosalind.info/problems/ba1l/
#
# Given: A DNA string Pattern.
# Return: PatternToNumber(Pattern).

let pattern = "AGT"

# The k-mers in lexicographic order are the base-4 numbers, with A=0, C=1, G=2,
# T=3. So the index is just the pattern read as a number in that base.
fn base_of(symbol) {
    if symbol == "A" then 0
    else if symbol == "C" then 1
    else if symbol == "G" then 2
    else 3
}

let number = range(0, len(pattern))
  |> reduce(|acc, i| acc * 4 + base_of(substr(pattern, i, 1)), 0)

println("Result:   " + str(number))
println("Expected: 11")

fn test_ba1l_pattern_to_number() {
    assert number == 11, "BA1L: got " + str(number)
    # The first and last k-mers of length 3 anchor the range.
    assert range(0, 3) |> reduce(|a, i| a * 4 + base_of("A"), 0) == 0, "BA1L: AAA should be 0"
}

BA1M — Implement NumberToPattern

solvedbrowser + CLI Problem statement Open in the workbench Download .bl

The inverse of BA1L.

# Rosalind: BA1M — Implement NumberToPattern
# https://rosalind.info/problems/ba1m/
#
# Given: Integers index and k.
# Return: NumberToPattern(index, k).

let index = 45
let k = 4

# The inverse of BA1L: read the index as a base-4 number, most significant digit
# first, with A=0, C=1, G=2, T=3.
let symbols = ["A", "C", "G", "T"]

let pattern = ""
let remaining = index
let position = 0
while position < k {
    let power = 1
    let e = 0
    while e < k - position - 1 {
        power = power * 4
        e = e + 1
    }
    let digit = int(remaining / power)
    pattern = pattern + symbols[digit]
    remaining = remaining - digit * power
    position = position + 1
}

println("Result:   " + pattern)
println("Expected: AGTC")

fn test_ba1m_number_to_pattern() {
    assert pattern == "AGTC", "BA1M: got " + pattern
    assert len(pattern) == k, "BA1M: wrong length"
}

BA1N — Generate the d-Neighborhood of a String

solvedbrowser + CLI Problem statement Open in the workbench Download .bl

Grown one position at a time, dropping any prefix that has already spent more than d substitutions.

# Rosalind: BA1N — Generate the d-Neighborhood of a String
# https://rosalind.info/problems/ba1n/
#
# Given: A DNA string Pattern and an integer d.
# Return: The collection Neighbors(Pattern, d) — every k-mer within d
# substitutions of Pattern.

let pattern = "ACG"
let d = 1

# Built by walking the pattern and, at each position, either keeping the base or
# spending one of the d substitutions on each of the other three. Written
# iteratively: grow the set of prefixes one position at a time, dropping any that
# have already overspent.
fn neighbourhood(text, allowed) {
    let bases = ["A", "C", "G", "T"]
    let partial = [{ prefix: "", used: 0 }]
    for i in range(0, len(text)) {
        let here = substr(text, i, 1)
        let next = []
        for candidate in partial {
            for base in bases {
                let cost = if base == here then 0 else 1
                if candidate.used + cost <= allowed {
                    next = push(next, { prefix: candidate.prefix + base, used: candidate.used + cost })
                }
            }
        }
        partial = next
    }
    partial |> map(|c| c.prefix)
}

let result = neighbourhood(pattern, d)

println("Result:   " + str(len(result)) + " neighbours")
println("Expected: 10")
println("  " + (sort(result) |> join(" ")))

fn test_ba1n_neighbourhood() {
    assert len(result) == 10, "BA1N: expected 10 neighbours, got " + str(len(result))
    # Every neighbour is within d, the pattern is its own neighbour, and there
    # are no duplicates.
    assert len(unique(result)) == len(result), "BA1N: duplicates in the neighbourhood"
    assert contains(result, pattern), "BA1N: the pattern is missing from its own neighbourhood"
    let too_far = result |> filter(|n| hamming_distance(n, pattern) > d)
    assert len(too_far) == 0, "BA1N: these exceed d — " + str(too_far)
}

BA2A — Implement MotifEnumeration

solvedbrowser + CLI Problem statement Open in the workbench Download .bl

A motif need not occur exactly anywhere, so the candidates are the neighbourhoods of the first string's windows: anything qualifying must be within d of one of them.

# Rosalind: BA2A — Implement MotifEnumeration
# https://rosalind.info/problems/ba2a/
#
# Given: Integers k and d, followed by a collection of strings Dna.
# Return: All (k, d)-motifs in Dna.

let k = 3
let d = 1
let strings = ["ATTTGGC", "TGCCTTA", "CGGTATC", "GAAAATT"]

# A (k, d)-motif appears in every string with at most d mismatches. It need not
# appear exactly anywhere, so the candidates are the neighbourhoods of the
# windows of the first string — anything qualifying must be within d of one of
# them.
fn neighbourhood(pattern, allowed) {
    let bases = ["A", "C", "G", "T"]
    let partial = [{ prefix: "", used: 0 }]
    for i in range(0, len(pattern)) {
        let here = substr(pattern, i, 1)
        let next = []
        for candidate in partial {
            for base in bases {
                let cost = if base == here then 0 else 1
                if candidate.used + cost <= allowed {
                    next = push(next, { prefix: candidate.prefix + base, used: candidate.used + cost })
                }
            }
        }
        partial = next
    }
    partial |> map(|c| c.prefix)
}

fn appears_in(text, motif, allowed) {
    let hits = range(0, len(text) - len(motif) + 1)
      |> filter(|i| hamming_distance(substr(text, i, len(motif)), motif) <= allowed)
    len(hits) > 0
}

let leader = strings[0]
let seen = []
for i in range(0, len(leader) - k + 1) {
    for candidate in neighbourhood(substr(leader, i, k), d) {
        if contains(seen, candidate) == false {
            let missing = strings |> filter(|s| appears_in(s, candidate, d) == false)
            if len(missing) == 0 {
                seen = push(seen, candidate)
            }
        }
    }
}

let result = sort(seen) |> join(" ")

println("Result:   " + result)
println("Expected: ATA ATT GTT TTT")

fn test_ba2a_motif_enumeration() {
    assert result == "ATA ATT GTT TTT", "BA2A: got " + result
}

BA2B — Find a Median String

solvedbrowser + CLI Problem statement Open in the workbench Download .bl

Every k-mer is a candidate, not only those occurring in the strings. Any minimiser is accepted, so the assertion checks the distance rather than the string: this finds ACG where the sample shows GAC, and both score 2.

# Rosalind: BA2B — Find a Median String
# https://rosalind.info/problems/ba2b/
#
# Given: An integer k and a collection of strings Dna.
# Return: A k-mer minimising d(Pattern, Dna) over all k-mers.

let k = 3
let strings = ["AAATTGACGCAT", "GACGACCACGTT", "CGTCAGCGCCTG", "GCTGAGCACCGG", "AGTACGGGACAG"]

fn distance_to(text, motif) {
    range(0, len(text) - len(motif) + 1)
      |> map(|i| hamming_distance(substr(text, i, len(motif)), motif))
      |> min()
}

fn total_distance(motif) {
    strings |> map(|s| distance_to(s, motif)) |> sum()
}

# Every k-mer is a candidate, not only those occurring in the strings — the
# median may appear in none of them. 4^k of them, enumerated as base-4 numbers.
let symbols = ["A", "C", "G", "T"]
fn number_to_pattern(index, width) {
    let out = ""
    let remaining = index
    let position = 0
    while position < width {
        let power = 1
        let e = 0
        while e < width - position - 1 {
            power = power * 4
            e = e + 1
        }
        let digit = int(remaining / power)
        out = out + symbols[digit]
        remaining = remaining - digit * power
        position = position + 1
    }
    out
}

let total_kmers = 1
let e = 0
while e < k {
    total_kmers = total_kmers * 4
    e = e + 1
}

let candidates = range(0, total_kmers) |> map(|i| number_to_pattern(i, k))
let scores = candidates |> map(|c| total_distance(c))
let best = min(scores)
let best_kmer = candidates[argmin(scores)]

println("Result:   " + best_kmer + "  (distance " + str(best) + ")")
println("Expected: GAC   (any k-mer achieving the minimum is accepted)")

fn test_ba2b_median_string() {
    assert total_distance(best_kmer) == best, "BA2B: the reported best_kmer is not minimal"
    assert total_distance("GAC") == best, "BA2B: GAC should achieve the same minimum"
    assert len(best_kmer) == k, "BA2B: wrong length"
}

BA2C — Find a Profile-most Probable k-mer

solvedbrowser + CLI Problem statement Open in the workbench Download .bl

The product down the profile's columns. Every entry here is non-zero so no window is ruled out, which is the situation pseudocounts exist to fix in the problems that follow.

# Rosalind: BA2C — Find a Profile-most Probable k-mer in a String
# https://rosalind.info/problems/ba2c/
#
# Given: A string Text, an integer k, and a 4 x k matrix Profile.
# Return: A Profile-most probable k-mer in Text.

let text = "ACCTGTTTATTGCCTAAGTTCCGAACAAACCCAATATAGCCCGAGGGCCT"
let k = 5

# Rows are A, C, G, T; columns are the positions of the k-mer.
let profile = [
    [0.2, 0.2, 0.3, 0.2, 0.3],
    [0.4, 0.3, 0.1, 0.5, 0.1],
    [0.3, 0.3, 0.5, 0.2, 0.4],
    [0.1, 0.2, 0.1, 0.1, 0.2],
]

fn row_of(symbol) {
    if symbol == "A" then 0
    else if symbol == "C" then 1
    else if symbol == "G" then 2
    else 3
}

# A k-mer's probability is the product down its columns. Every entry here is
# non-zero, so no window is ruled out; a profile with a zero would silently
# eliminate one, which is why pseudocounts exist in the problems that follow.
fn probability(kmer) {
    range(0, len(kmer))
      |> reduce(|acc, i| acc * profile[row_of(substr(kmer, i, 1))][i], 1.0)
}

let kmer_windows = range(0, len(text) - k + 1) |> map(|i| substr(text, i, k))
let scores = kmer_windows |> map(|w| probability(w))
let best = kmer_windows[argmax(scores)]

println("Result:   " + best)
println("Expected: CCGAG")

fn test_ba2c_profile_most_probable() {
    assert best == "CCGAG", "BA2C: got " + best
    assert probability(best) == max(scores), "BA2C: the reported k-mer is not the most probable"
}

BA2H — Implement DistanceBetweenPatternAndStrings

solvedbrowser + CLI Problem statement Open in the workbench Download .bl

Best per string, summed across them: a motif only has to occur once in each.

# Rosalind: BA2H — Implement DistanceBetweenPatternAndStrings
# https://rosalind.info/problems/ba2h/
#
# Given: A DNA string Pattern and a collection of DNA strings Dna.
# Return: DistanceBetweenPatternAndStrings(Pattern, Dna).

let pattern = "AAA"
let strings = ["TTACCTTAAC", "GATATCTGTC", "ACGGCGTTCG", "CCCTAAAGAG", "CGTCAGAGGT"]

# The distance to one string is the best any window of it can do; the distance
# to the collection is the sum over strings. Best, not total, because a motif
# only has to occur once per string.
fn distance_to(text, motif) {
    range(0, len(text) - len(motif) + 1)
      |> map(|i| hamming_distance(substr(text, i, len(motif)), motif))
      |> min()
}

let total = strings |> map(|s| distance_to(s, pattern)) |> sum()

println("Result:   " + str(total))
println("Expected: 5")

fn test_ba2h_distance_between_pattern_and_strings() {
    assert total == 5, "BA2H: got " + str(total)
    # A pattern present exactly in every string would score zero.
    assert distance_to("AAACCC", "AAA") == 0, "BA2H: an exact occurrence should cost nothing"
}

BA3B — Reconstruct a String from its Genome Path

solvedbrowser + CLI Problem statement Open in the workbench Download .bl

The path is already ordered, so the string is the first k-mer plus one symbol from each after it. Finding the order is what BA3C and BA3H are for.

# Rosalind: BA3B — Reconstruct a String from its Genome Path
# https://rosalind.info/problems/ba3b/
#
# Given: A sequence of k-mers where each overlaps the next by k-1 symbols.
# Return: The string they spell.

let path = ["ACCGA", "CCGAA", "CGAAG", "GAAGC", "AAGCT"]

# The path is already in order, so the string is the first k-mer plus the last
# symbol of each one after it. No overlap has to be searched for — that is what
# BA3C and BA3H are for.
let text = range(1, len(path))
  |> reduce(|acc, i| acc + substr(path[i], len(path[i]) - 1, 1), path[0])

println("Result:   " + text)
println("Expected: ACCGAAGCT")

fn test_ba3b_genome_path() {
    assert text == "ACCGAAGCT", "BA3B: got " + text
    assert len(text) == len(path[0]) + len(path) - 1, "BA3B: length should be k + n - 1"
}

BA3C — Construct the Overlap Graph of a Collection of k-mers

solvedbrowser + CLI Problem statement Open in the workbench Download .bl

An edge where one k-mer's suffix is another's prefix. Written with `source` and `target` because `from` and `to` are reserved words.

# Rosalind: BA3C — Construct the Overlap Graph of a Collection of k-mers
# https://rosalind.info/problems/ba3c/
#
# Given: A collection of k-mers.
# Return: The overlap graph as an adjacency list.

let patterns = ["ATGCG", "GCATG", "CATGC", "AGGCA", "GGCAT"]

# An edge runs from one k-mer to another when the suffix of the first is the
# prefix of the second — the relation assembly walks. A k-mer is not joined to
# itself unless it genuinely overlaps itself.
fn suffix_of(pattern) { substr(pattern, 1, len(pattern) - 1) }
fn prefix_of(pattern) { substr(pattern, 0, len(pattern) - 1) }

let overlaps = []
for source in patterns {
    for target in patterns {
        if source != target and suffix_of(source) == prefix_of(target) {
            overlaps = push(overlaps, source + " -> " + target)
        }
    }
}

let result = sort(overlaps)

println("Result:")
for edge in result {
    println("  " + edge)
}
println("Expected: AGGCA -> GGCAT / CATGC -> ATGCG / GCATG -> CATGC / GGCAT -> GCATG")

fn test_ba3c_overlap_graph() {
    assert len(result) == 4, "BA3C: expected 4 overlaps, got " + str(len(result))
    for expected in ["AGGCA -> GGCAT", "CATGC -> ATGCG", "GCATG -> CATGC", "GGCAT -> GCATG"] {
        assert contains(result, expected), "BA3C: missing " + expected
    }
}

BA3D — Construct the De Bruijn Graph of a String

solvedbrowser + CLI Problem statement Open in the workbench Download .bl

Nodes are (k-1)-mers and edges are the k-mers, which is the inversion that turns assembly into an Eulerian path problem rather than a Hamiltonian one.

# Rosalind: BA3D — Construct the De Bruijn Graph of a String
# https://rosalind.info/problems/ba3d/
#
# Given: An integer k and a string Text.
# Return: DeBruijn_k(Text) as an adjacency list.

let k = 4
let text = "AAGATTCTCTAC"

# Nodes are (k-1)-mers and edges are the k-mers: each k-mer joins its own prefix
# to its own suffix. That is the inversion that makes assembly an Eulerian path
# problem rather than a Hamiltonian one — edges are what must be used, not nodes.
let adjacency = {}
for i in range(0, len(text) - k + 1) {
    let mer = substr(text, i, k)
    let source = substr(mer, 0, k - 1)
    let target = substr(mer, 1, k - 1)
    if contains(keys(adjacency), source) {
        adjacency[source] = push(adjacency[source], target)
    } else {
        adjacency[source] = [target]
    }
}

# Repeated edges are kept — a k-mer occurring twice is two edges, which is what
# lets the assembly traverse a repeat the right number of times.
let result = sort(keys(adjacency)) |> map(|node| node + " -> " + (sort(adjacency[node]) |> join(",")))

println("Result:")
for line in result {
    println("  " + line)
}
println("Expected: AAG -> AGA / TCT -> CTA,CTC / ... (8 lines)")

fn test_ba3d_de_bruijn_of_a_string() {
    assert len(result) == 8, "BA3D: expected 8 nodes, got " + str(len(result))
    assert contains(result, "TCT -> CTA,CTC"), "BA3D: TCT should branch to both"
    assert contains(result, "AAG -> AGA"), "BA3D: missing AAG -> AGA"
    # Every k-mer of the text is one edge.
    let edge_count = result |> map(|l| len(split(substr(l, index_of(l, "-> ") + 3, len(l)), ","))) |> sum()
    assert edge_count == len(text) - k + 1, "BA3D: edges should equal the number of k-mers"
}

BA3E — Construct the De Bruijn Graph of a Collection of k-mers

solvedbrowser + CLI Problem statement Open in the workbench Download .bl

The same construction from a bag of reads rather than a string. A duplicate k-mer stays duplicated: it is evidence of a repeat, not noise.

# Rosalind: BA3E — Construct the De Bruijn Graph of a Collection of k-mers
# https://rosalind.info/problems/ba3e/
#
# Given: A collection of k-mers.
# Return: The de Bruijn graph as an adjacency list.

let patterns = ["GAGG", "CAGG", "GGGG", "GGGA", "CAGG", "AGGG", "GGAG"]

# Same construction as BA3D, but the k-mers arrive as a bag rather than being
# read out of a string — which is the realistic case, since reads are what a
# sequencer produces. CAGG appears twice in the input and must appear twice in
# the graph: duplicate reads are evidence of a repeat, not noise to discard.
let adjacency = {}
for mer in patterns {
    let source = substr(mer, 0, len(mer) - 1)
    let target = substr(mer, 1, len(mer) - 1)
    if contains(keys(adjacency), source) {
        adjacency[source] = push(adjacency[source], target)
    } else {
        adjacency[source] = [target]
    }
}

let result = sort(keys(adjacency)) |> map(|node| node + " -> " + (sort(adjacency[node]) |> join(",")))

println("Result:")
for line in result {
    println("  " + line)
}
println("Expected: AGG -> GGG / CAG -> AGG,AGG / GAG -> AGG / GGA -> GAG / GGG -> GGA,GGG")

fn test_ba3e_de_bruijn_of_a_collection() {
    assert len(result) == 5, "BA3E: expected 5 nodes, got " + str(len(result))
    assert contains(result, "CAG -> AGG,AGG"), "BA3E: the repeated k-mer must stay repeated"
    assert contains(result, "GGG -> GGA,GGG"), "BA3E: missing GGG's two edges"
}

BA5A — Find the Minimum Number of Coins Needed to Make Change

solvedbrowser + CLI Problem statement Open in the workbench Download .bl

The greedy answer is wrong here and that is the point: taking 25 first needs three coins where 20+20 needs two.

# Rosalind: BA5A — Find the Minimum Number of Coins Needed to Make Change
# https://rosalind.info/problems/ba5a/
#
# Given: An integer money and an array Coins.
# Return: The minimum number of coins making that amount.

let money = 40
let coins = [1, 5, 10, 20, 25, 50]

# The greedy answer is wrong here and that is the point of the problem: greedily
# taking 25 leaves 15, needing 25+10+5 = three coins, where 20+20 is two. So
# every amount up to the target is solved from the smaller amounts below it.
let fewest = repeat([0], money + 1)
for amount in range(1, money + 1) {
    let best = money + 1
    for coin in coins {
        if coin <= amount and fewest[amount - coin] + 1 < best {
            best = fewest[amount - coin] + 1
        }
    }
    fewest[amount] = best
}

println("Result:   " + str(fewest[money]))
println("Expected: 2   (20 + 20; greedily taking 25 first would need three)")

fn test_ba5a_minimum_coins() {
    assert fewest[money] == 2, "BA5A: got " + str(fewest[money])
    assert fewest[0] == 0, "BA5A: no coins are needed for nothing"
}

BA5C — Find a Longest Common Subsequence of Two Strings

solvedbrowser + CLI Problem statement Open in the workbench Download .bl

lcs is a builtin. More than one subsequence is longest, so the assertion checks the length and that it really is a subsequence of both.

# Rosalind: BA5C — Find a Longest Common Subsequence of Two Strings
# https://rosalind.info/problems/ba5c/
#
# Given: Two strings.
# Return: A longest common subsequence.

let s = "AACCTTGG"
let t = "ACACTGTGA"

# lcs is a builtin. There is generally more than one longest common
# subsequence — the sample shows AACTGG, this returns another of the same
# length — so the assertion checks the length and that it really is a
# subsequence of both, which is what the problem asks for.
let common = lcs(s, t)

println("Result:   " + common + "  (length " + str(len(common)) + ")")
println("Expected: AACTGG, or any other subsequence of length 6")

fn test_ba5c_longest_common_subsequence() {
    assert len(common) == 6, "BA5C: expected length 6, got " + str(len(common))
    assert is_subsequence(common, s), "BA5C: not a subsequence of s"
    assert is_subsequence(common, t), "BA5C: not a subsequence of t"
    assert len(lcs("AACTGG", t)) == 6, "BA5C: the sample answer should also be length 6"
}

BA5E — Find a Highest-Scoring Alignment of Two Strings

solvedbrowser + CLI Problem statement Open in the workbench Download .bl

One call: global, BLOSUM62, linear gap of 5.

# Rosalind: BA5E — Find a Highest-Scoring Alignment of Two Strings
# https://rosalind.info/problems/ba5e/
#
# Given: Two amino acid strings.
# Return: The maximum global alignment score, and an alignment achieving it.
# BLOSUM62 with indel penalty 5.

let s = "PLEASANTLY"
let t = "MEANLY"

# One call: global mode, a linear gap of 5, scored from BLOSUM62. The match and
# mismatch arguments are ignored for residues the matrix carries, which is all
# of them here.
let result = align(s, t, "global", 0, 0, -5, 0, "blosum62")

println("Result:   " + str(result.score))
println("Expected: 8")
println("Alignment:")
println("  " + result.aligned_a)
println("  " + result.aligned_b)

fn test_ba5e_global_alignment() {
    assert result.score == 8, "BA5E: got " + str(result.score)
    # Both rows of a global alignment cover their whole string.
    assert len(result.aligned_a) == len(result.aligned_b), "BA5E: rows differ in length"
}

BA5F — Find a Highest-Scoring Local Alignment of Two Strings

solvedbrowser + CLI Problem statement Open in the workbench Download .bl

PAM250, not BLOSUM62 — the two disagree enough to change the answer, and the problem says which it wants.

# Rosalind: BA5F — Find a Highest-Scoring Local Alignment of Two Strings
# https://rosalind.info/problems/ba5f/
#
# Given: Two amino acid strings.
# Return: The maximum local alignment score, and an alignment achieving it.
# PAM250 with indel penalty 5.

let s = "MEANLY"
let t = "PENALTY"

# PAM250, not BLOSUM62 — the two matrices disagree enough to change the answer,
# and the problem says which one it wants.
let result = align(s, t, "local", 0, 0, -5, 0, "pam250")

println("Result:   " + str(result.score))
println("Expected: 15")
println("Alignment:")
println("  " + result.aligned_a)
println("  " + result.aligned_b)

fn test_ba5f_local_alignment() {
    assert result.score == 15, "BA5F: got " + str(result.score)
    # A local alignment can only do at least as well as the same pair scored
    # globally, since it may discard the ends.
    assert result.score >= align(s, t, "global", 0, 0, -5, 0, "pam250").score,
        "BA5F: local scored below global"
}

BA5H — Find a Highest-Scoring Fitting Alignment of Two Strings

solvedbrowser + CLI Problem statement Open in the workbench Download .bl

All of w against any window of v. Semiglobal returns the same number on this input for a different reason — it would clip w's ends too — so a fitting mode was added rather than asserting the coincidence.

# Rosalind: BA5H — Find a Highest-Scoring Fitting Alignment of Two Strings
# https://rosalind.info/problems/ba5h/
#
# Given: Two DNA strings v and w, v much the longer.
# Return: The maximum fitting alignment score, and an alignment achieving it.
# Match +1, mismatch and indel both -1.

let v = dna"GTAGGCTTAAGGTTA"
let w = dna"TAGATA"

# Fitting: all of w, any window of v. That is not the same as semiglobal, which
# forgives the end gaps of both sequences and so would let w be clipped too. On
# this input the two happen to agree, which is exactly why the distinction is
# worth making rather than reaching for whichever mode returns the right number.
let result = align(v, w, "fitting", 1, -1, -1, 0)

# w must appear in full: its row of the alignment, gaps removed, is all of w.
fn without_gaps(row) {
    range(0, len(row)) |> map(|i| substr(row, i, 1)) |> filter(|c| c != "-") |> join("")
}

println("Result:   " + str(result.score))
println("Expected: 2")
println("Alignment:")
println("  " + result.aligned_a)
println("  " + result.aligned_b)

fn test_ba5h_fitting_alignment() {
    assert result.score == 2, "BA5H: got " + str(result.score)
    assert without_gaps(result.aligned_b) == str(w),
        "BA5H: w is not fully aligned — that is what makes this fitting rather than local"
    assert contains(str(v), without_gaps(result.aligned_a)),
        "BA5H: the aligned part of v is not a window of v"
}

BA5I — Find a Highest-Scoring Overlap Alignment of Two Strings

solvedbrowser + CLI Problem statement Open in the workbench Download .bl

The shape read assembly asks for: where the end of one read agrees with the start of the next.

# Rosalind: BA5I — Find a Highest-Scoring Overlap Alignment of Two Strings
# https://rosalind.info/problems/ba5i/
#
# Given: Two protein strings v and w.
# Return: The maximum overlap alignment score, and an alignment of a suffix of v
# with a prefix of w. Match +1, mismatch and indel both -2.

let v = "PAWHEAE"
let w = "HEAGAWGHEE"

# Overlap alignment is the shape read assembly asks for: where does the end of
# one read agree with the start of the next. A prefix of v and a suffix of w are
# both free.
let result = align(v, w, "overlap", 1, -2, -2, 0)

fn without_gaps(row) {
    range(0, len(row)) |> map(|i| substr(row, i, 1)) |> filter(|c| c != "-") |> join("")
}

println("Result:   " + str(result.score))
println("Expected: 1")
println("Alignment:")
println("  " + result.aligned_a)
println("  " + result.aligned_b)

fn test_ba5i_overlap_alignment() {
    assert result.score == 1, "BA5I: got " + str(result.score)
    # The aligned pieces are a suffix of v and a prefix of w.
    let piece_v = without_gaps(result.aligned_a)
    let piece_w = without_gaps(result.aligned_b)
    assert substr(v, len(v) - len(piece_v), len(piece_v)) == piece_v,
        "BA5I: " + piece_v + " is not a suffix of v"
    assert substr(w, 0, len(piece_w)) == piece_w, "BA5I: " + piece_w + " is not a prefix of w"
}

BA5J — Align Two Strings Using Affine Gap Penalties

solvedbrowser + CLI Problem statement Open in the workbench Download .bl

Charging for opening a gap and less per symbol after is what stops one long insertion being priced as a run of unrelated ones.

# Rosalind: BA5J — Align Two Strings Using Affine Gap Penalties
# https://rosalind.info/problems/ba5j/
#
# Given: Two amino acid strings v and w.
# Return: The maximum alignment score, and an alignment achieving it.
# BLOSUM62, gap opening 11, gap extension 1.

let v = "PRTEINS"
let w = "PRTWPSEIN"

# Affine gaps charge for opening a gap and then less per symbol after, which is
# what stops a long insertion being priced as a run of unrelated ones. A gap of
# length L costs 11 + (L-1), so opening is -10 on top of the -1 each symbol pays.
let result = align(v, w, "global", 0, 0, -1, -10, "blosum62")

# The same pair under a linear gap of 11 per symbol, for contrast.
let linear = align(v, w, "global", 0, 0, -11, 0, "blosum62")

println("Result:   " + str(result.score))
println("Expected: 8")
println("Alignment:")
println("  " + result.aligned_a)
println("  " + result.aligned_b)
println("(the same pair with a flat gap of 11 scores " + str(linear.score) + ")")

fn test_ba5j_affine_gap_alignment() {
    assert result.score == 8, "BA5J: got " + str(result.score)
    # Charging less for continuing a gap can only help.
    assert result.score >= linear.score, "BA5J: affine scored below a flat gap"
}

BA8A — Implement FarthestFirstTraversal

solvedbrowser + CLI Problem statement Open in the workbench Download .bl

Each new center is the point furthest from all chosen so far. Deterministic, unlike k-means, which is why it is used to seed clustering rather than to do it.

# Rosalind: BA8A — Implement FarthestFirstTraversal
# https://rosalind.info/problems/ba8a/
#
# Given: Integers k and m, then a set of points in m-dimensional space.
# Return: The k centers FarthestFirstTraversal chooses, starting from the first
# point of the data.

let k = 3
let points = [
    [0.0, 0.0], [5.0, 5.0], [0.0, 5.0], [1.0, 1.0],
    [2.0, 2.0], [3.0, 3.0], [1.0, 2.0],
]

fn distance(a, b) {
    sqrt(range(0, len(a)) |> map(|i| (a[i] - b[i]) * (a[i] - b[i])) |> sum())
}

# Each new center is the point furthest from every center chosen so far. That
# makes it deterministic — unlike k-means, which depends on where it starts —
# and it is why this is used to seed clustering rather than to do it: the points
# it picks are the extremes, not the middles.
let centers = [points[0]]
while len(centers) < k {
    let spreads = points |> map(|p| centers |> map(|c| distance(p, c)) |> min())
    centers = push(centers, points[argmax(spreads)])
}

let result = centers |> map(|c| c |> map(|v| str(v)) |> join(" ")) |> join(" / ")

println("Result:   " + result)
println("Expected: 0 0 / 5 5 / 0 5")

fn test_ba8a_farthest_first_traversal() {
    assert len(centers) == k, "BA8A: expected k centers"
    assert centers[0] == points[0], "BA8A: the first point seeds the traversal"
    assert contains(centers, [5.0, 5.0]), "BA8A: 5.0 5.0 should be chosen"
    assert contains(centers, [0.0, 5.0]), "BA8A: 0.0 5.0 should be chosen"
}

BA8B — Compute the Squared Error Distortion

solvedbrowser + CLI Problem statement Open in the workbench Download .bl

Squared, so one badly placed point counts for far more than several slightly-off ones. This is the quantity k-means minimises.

# Rosalind: BA8B — Compute the Squared Error Distortion
# https://rosalind.info/problems/ba8b/
#
# Given: Integers k and m, a set of centers, and a set of points.
# Return: The squared error distortion.

let centers = [[2.31, 4.55], [5.96, 9.08]]
let points = [
    [3.42, 6.03], [6.23, 8.25], [4.76, 1.64], [4.47, 4.33], [3.95, 7.61],
    [8.93, 2.97], [9.74, 4.03], [1.73, 1.28], [9.72, 5.01], [7.27, 3.77],
]

fn distance(a, b) {
    sqrt(range(0, len(a)) |> map(|i| (a[i] - b[i]) * (a[i] - b[i])) |> sum())
}

# Distortion is the mean squared distance from each point to its nearest center
# — squared, so a single badly-placed point counts for much more than several
# slightly-off ones. That is what k-means is minimising.
let distortion = (points
  |> map(|p| { let d = centers |> map(|c| distance(p, c)) |> min()
               d * d })
  |> sum()) / float(len(points))

println("Result:   " + str(round(distortion, 3)))
println("Expected: 18.246")

fn test_ba8b_squared_error_distortion() {
    assert round(distortion, 3) == 18.246, "BA8B: got " + str(round(distortion, 3))
    # A point sitting on a center contributes nothing.
    assert distance([1.0, 1.0], [1.0, 1.0]) == 0.0, "BA8B: distance to itself should be zero"
}

BA8C — Implement the Lloyd Algorithm for k-Means Clustering

solvedbrowser + CLI Problem statement Open in the workbench Download .bl

Assign, then move each center to the mean of what it was assigned, until nothing moves. Seeded with the first k points because Lloyd's converges differently from different seeds — which is what BA8A exists to address.

# Rosalind: BA8C — Implement the Lloyd Algorithm for k-Means Clustering
# https://rosalind.info/problems/ba8c/
#
# Given: Integers k and m, then a set of points.
# Return: The centers Lloyd's algorithm converges to, seeded with the first k
# points of the data.

let k = 2
let points = [
    [1.3, 1.1], [1.3, 0.2], [0.6, 2.8], [3.0, 3.2], [1.2, 0.7], [1.4, 1.6],
    [1.2, 1.0], [1.2, 1.1], [0.6, 1.5], [1.8, 2.6], [1.2, 1.3], [1.2, 1.0],
    [0.0, 1.9],
]

fn distance(a, b) {
    sqrt(range(0, len(a)) |> map(|i| (a[i] - b[i]) * (a[i] - b[i])) |> sum())
}

# Two steps, alternating until nothing moves: assign every point to its nearest
# center, then move each center to the mean of what it was assigned. Seeded with
# the first k points, because the problem says so — Lloyd's converges to
# different answers from different seeds, which is why BA8A exists.
let centers = slice(points, 0, k)
let settled = false
let rounds = 0
while settled == false and rounds < 100 {
    let assignment = points |> map(|p| argmin(centers |> map(|c| distance(p, c))))
    let moved = []
    for index in range(0, k) {
        let members = range(0, len(points)) |> filter(|i| assignment[i] == index) |> map(|i| points[i])
        if len(members) == 0 {
            moved = push(moved, centers[index])
        } else {
            moved = push(moved, range(0, len(members[0]))
              |> map(|d| (members |> map(|p| p[d]) |> sum()) / float(len(members))))
        }
    }
    if moved == centers then settled = true
    centers = moved
    rounds = rounds + 1
}

let result = centers |> map(|c| c |> map(|v| str(round(v, 3))) |> join(" ")) |> join(" / ")

println("Result:   " + result)
println("Expected: 1.8 2.867 / 1.06 1.14   (converged in " + str(rounds) + " rounds)")

fn test_ba8c_lloyd_k_means() {
    assert settled, "BA8C: Lloyd's did not converge"
    let flat = centers |> map(|c| c |> map(|v| round(v, 3)))
    assert contains(flat, [1.8, 2.867]), "BA8C: missing the upper center, got " + str(flat)
    assert contains(flat, [1.06, 1.14]), "BA8C: missing the lower center, got " + str(flat)
}

BA9D — Find the Longest Repeat in a String

solvedbrowser + CLI Problem statement Open in the workbench Download .bl

The largest entry in the LCP array, and nothing else. Two suffixes sharing a long prefix is what a repeat is, so the array has already found every one of them before the problem is read.

# Rosalind: BA9D — Find the Longest Repeat in a String
# https://rosalind.info/problems/ba9d/
#
# Given: A string Text.
# Return: A longest substring occurring more than once.

let text = "ATATCGTTTTATCGTT"

# Two suffixes sharing a long prefix is exactly a repeat, and the LCP array
# lists every such sharing between neighbours in sorted order. The longest
# repeat is the largest value in it — no search needed, only a maximum.
let padded = text + "$"
let sa = suffix_array(padded)
let lcp = lcp_array(padded)

let best = max(lcp)
let deepest = argmax(lcp)
let repeat_seq = substr(padded, sa[deepest], best)

println("Result:   " + repeat_seq + "  (length " + str(best) + ")")
println("Expected: TATCGTT   (any longest repeat is accepted)")

fn test_ba9d_longest_repeat() {
    assert len(repeat_seq) == 7, "BA9D: expected length 7, got " + str(len(repeat_seq))
    # It must genuinely occur more than once.
    assert len(find_motif(dna(text), dna(repeat_seq))) >= 2,
        "BA9D: " + repeat_seq + " does not repeat"
    assert len(find_motif(dna(text), dna("TATCGTT"))) >= 2, "BA9D: the sample answer should repeat too"
}

BA9E — Find the Longest Substring Shared by Two Strings

solvedbrowser + CLI Problem statement Open in the workbench Download .bl

Concatenate with a separator, then take the largest LCP between neighbouring suffixes that came from different sides. The separator is load-bearing: without it a match can run across the join and name a substring neither string contains.

# Rosalind: BA9E — Find the Longest Substring Shared by Two Strings
# https://rosalind.info/problems/ba9e/
#
# Given: Two strings.
# Return: The longest substring occurring in both.

let first_text = "TCGGTAGATTGCGCCCACTC"
let second_text = "AGGGGCTCGCAGTGTAAGAA"

# Join the two with a separator that appears in neither, then take the suffix
# array of the pair. Neighbouring suffixes that come from *different* sides and
# share a long prefix are a shared substring — the separator is what stops a
# match running across the join and claiming something neither string contains.
let joined = first_text + "#" + second_text + "$"
let split_at = len(first_text)
let sa = suffix_array(joined)
let lcp = lcp_array(joined)

fn side_of(position) { if position < split_at then 0 else 1 }

let best = 0
let best_start = 0
for i in range(1, len(sa)) {
    if side_of(sa[i]) != side_of(sa[i - 1]) and lcp[i] > best {
        best = lcp[i]
        best_start = sa[i]
    }
}

let shared = substr(joined, best_start, best)

println("Result:   " + shared + "  (length " + str(best) + ")")
println("Expected: AGA   (any longest shared substring is accepted)")

fn test_ba9e_longest_shared_substring() {
    assert len(shared) == 3, "BA9E: expected length 3, got " + str(len(shared))
    assert contains(first_text, shared), "BA9E: " + shared + " is not in the first string"
    assert contains(second_text, shared), "BA9E: " + shared + " is not in the second string"
}

BA9I — Construct the Burrows-Wheeler Transform of a String

solvedbrowser + CLI Problem statement Open in the workbench Download .bl

Sorting rotations and sorting suffixes agree once the string ends in a sentinel, so the suffix array gives the transform directly — the character before each sorted suffix.

# Rosalind: BA9I — Construct the Burrows-Wheeler Transform of a String
# https://rosalind.info/problems/ba9i/
#
# Given: A string Text.
# Return: BWT(Text).

let text = "GCGTGCCTGGTCA$"

# The BWT is the last column of the sorted rotations — but sorting rotations is
# the same as sorting suffixes when the string ends in a sentinel, so the suffix
# array gives it directly: the character just before each sorted suffix.
let n = len(text)
let sa = suffix_array(text)
let bwt = sa |> map(|i| substr(text, (i + n - 1) % n, 1)) |> join("")

println("Result:   " + bwt)
println("Expected: ACTGGCT$TGCGGC")

fn test_ba9i_burrows_wheeler_transform() {
    assert bwt == "ACTGGCT$TGCGGC", "BA9I: got " + bwt
    # A permutation of the input, which is what makes it invertible.
    assert len(bwt) == n, "BA9I: wrong length"
    assert sort(chars(bwt)) == sort(chars(text)), "BA9I: not a permutation of the input"
}

BA9J — Reconstruct a String from its Burrows-Wheeler Transform

solvedbrowser + CLI Problem statement Open in the workbench Download .bl

The k-th occurrence of a symbol in the first column is the k-th in the last. That correspondence alone rebuilds the text, which is why the transform can be stored without anything beside it.

# Rosalind: BA9J — Reconstruct a String from its Burrows-Wheeler Transform
# https://rosalind.info/problems/ba9j/
#
# Given: A string Transform.
# Return: The Text whose BWT is Transform.

let transform = "TTCCTAACG$A"

# The first column is the last column sorted, and the k-th occurrence of a
# character in one column is the k-th occurrence in the other — that
# correspondence is the whole trick, and it is why the transform is reversible
# without storing anything alongside it.
let n = len(transform)
let last_column = range(0, n) |> map(|i| substr(transform, i, 1))
let first_column = sort(last_column)

# Rank each position among its own character's occurrences.
fn ranks_of(column) {
    let seen = {}
    let out = []
    for symbol in column {
        let count = if contains(keys(seen), symbol) then seen[symbol] else 0
        out = push(out, count)
        seen[symbol] = count + 1
    }
    out
}

let last_rank = ranks_of(last_column)
let first_rank = ranks_of(first_column)

# Where does row i of the last column appear in the first?
let lf = range(0, n) |> map(|i| {
    let want = last_column[i]
    let want_rank = last_rank[i]
    (range(0, n) |> filter(|j| first_column[j] == want and first_rank[j] == want_rank))[0]
})

# Walk backwards from the row starting with the sentinel.
let walk_row = 0
let out = ""
for _ in range(0, n) {
    out = last_column[walk_row] + out
    walk_row = lf[walk_row]
}

# The walk produces the text rotated so the sentinel leads; move it to the end.
let text = substr(out, 1, n - 1) + substr(out, 0, 1)

println("Result:   " + text)
println("Expected: TACATCACGT$")

fn test_ba9j_inverse_burrows_wheeler() {
    assert text == "TACATCACGT$", "BA9J: got " + text
    # Round trip: transforming the answer returns the input.
    let sa = suffix_array(text)
    let back = sa |> map(|i| substr(text, (i + n - 1) % n, 1)) |> join("")
    assert back == transform, "BA9J: the round trip does not return the transform"
}

BA10A — Compute the Probability of a Hidden Path

solvedbrowser + CLI Problem statement Open in the workbench Download .bl

One product of fifty transitions, which lands at 1e-19 — the concrete reason the decoding problems that follow are done in log space rather than directly.

# Rosalind: BA10A — Compute the Probability of a Hidden Path
# https://rosalind.info/problems/ba10a/
#
# Given: A hidden path pi, the states of an HMM, and its transition matrix.
# Return: Pr(pi).

let hidden_path = "AABBBAABABAAAABBBBAABBABABBBAABBAAAABABAABBABABBAB"

# No emissions are involved, so the model needs only its states and how they
# follow one another.
let model = {
    states: ["A", "B"],
    transition: {
        A: { A: 0.194, B: 0.806 },
        B: { A: 0.273, B: 0.727 },
    },
}

# Every state is equally likely to start, then each step multiplies in one
# transition. Fifty of them take the answer down to 1e-19, which is what makes
# the log-space treatment in BA10C and BA10D necessary rather than fussy.
let probability = hmm_path_probability(hidden_path, model)

# Printed as a mantissa and an exponent; the plain decimal expansion of 1e-19
# is unreadable next to the published answer.
println("Result:   " + str(round(probability * 1e19, 6)) + "e-19")
println("Expected: 5.017329e-19")

fn test_ba10a_hidden_path_probability() {
    assert abs(probability - 5.01732865318e-19) < 1e-30,
        "BA10A: got " + str(probability)
    # The same thing computed by hand, to check the builtin agrees with the
    # definition rather than only with itself.
    let steps = chars(hidden_path)
    let by_hand = range(1, len(steps))
        |> reduce(|running, i| running * model.transition[steps[i - 1]][steps[i]], 0.5)
    assert abs(probability - by_hand) < 1e-30, "BA10A: builtin and hand computation disagree"
}

BA10B — Compute the Probability of an Outcome Given a Hidden Path

solvedbrowser + CLI Problem statement Open in the workbench Download .bl

Conditioning on the path makes the positions independent, so the transitions never enter into it. Checked against the same product taken by hand.

# Rosalind: BA10B — Compute the Probability of an Outcome Given a Hidden Path
# https://rosalind.info/problems/ba10b/
#
# Given: A string x, its alphabet, a hidden path pi, the states, and the
# emission matrix.
# Return: Pr(x | pi).

let observed = "xxyzyxzzxzxyxyyzxxzzxxyyxxyxyzzxxyzyzxzxxyxyyzxxzx"
let hidden_path = "BBBAAABABABBBBBBAAAAAABAAAABABABBBBBABAABABABABBBB"

# The path is given, so transitions never come into it — only what each state
# emitted.
let model = {
    states: ["A", "B"],
    symbols: ["x", "y", "z"],
    emission: {
        A: { x: 0.612, y: 0.314, z: 0.074 },
        B: { x: 0.346, y: 0.317, z: 0.336 },
    },
}

# Conditioning on the path makes the positions independent, so this is one
# product of fifty emissions and nothing more.
let probability = hmm_emission_probability(observed, hidden_path, model)

println("Result:   " + str(round(probability * 1e28, 6)) + "e-28")
println("Expected: 1.931571e-28")

fn test_ba10b_outcome_given_path() {
    assert abs(probability - 1.93157070893e-28) < 1e-38,
        "BA10B: got " + str(probability)
    assert len(observed) == len(hidden_path), "BA10B: the sample's string and path are both 50"
    # The same product taken by hand.
    let symbols = chars(observed)
    let states = chars(hidden_path)
    let by_hand = range(0, len(symbols))
        |> reduce(|running, i| running * model.emission[states[i]][symbols[i]], 1.0)
    assert abs(probability - by_hand) < 1e-38, "BA10B: builtin and hand computation disagree"
}

BA10C — Implement the Viterbi Algorithm

solvedbrowser + CLI Problem statement Open in the workbench Download .bl

The problem this pack was built to reach: HMM decoding is what gene finders, profile search and segmentation all run on, and nothing in the tree could do it before.

# Rosalind: BA10C — Implement the Viterbi Algorithm
# https://rosalind.info/problems/ba10c/
#
# Given: A string x, the alphabet it was emitted from, the states of an HMM, and
# its transition and emission matrices.
# Return: A path that maximises the probability of x over all hidden paths.

let observed = "xyxzzxyxyy"

# A model is a plain record, so it reads the way the problem states it. The
# matrices are keyed by name in both directions — a transposed transition matrix
# is otherwise a wrong answer rather than an error, and it is the mistake
# everyone makes first.
let model = {
    states: ["A", "B"],
    symbols: ["x", "y", "z"],
    transition: {
        A: { A: 0.641, B: 0.359 },
        B: { A: 0.729, B: 0.271 },
    },
    emission: {
        A: { x: 0.117, y: 0.691, z: 0.192 },
        B: { x: 0.097, y: 0.42,  z: 0.483 },
    },
}

# Viterbi keeps, for each state at each position, the best path reaching it —
# and every path that is not best is dropped immediately. That is what makes it
# linear in the string instead of exponential in it.
let path = viterbi(observed, model) |> join("")

println("Result:   " + path)
println("Expected: AAABBAAAAA")

fn test_ba10c_viterbi() {
    assert path == "AAABBAAAAA", "BA10C: got " + path
    assert len(path) == len(observed), "BA10C: the path must be as long as the string"
    # No other path can score higher — check against the joint probability of the
    # path itself, which is what Viterbi claims to maximise.
    let best = hmm_path_probability(path, model)
             * hmm_emission_probability(observed, path, model)
    let rival = "BBBBBBBBBB"
    let worse = hmm_path_probability(rival, model)
              * hmm_emission_probability(observed, rival, model)
    assert best > worse, "BA10C: an all-B path scores at least as well"
}

BA10D — Compute the Probability of a String Emitted by an HMM

solvedbrowser + CLI Problem statement Open in the workbench Download .bl

The forward algorithm. Its assertion enumerates all 1024 paths of the sample and sums them, so the collapse is checked against the thing it replaces rather than only against a published number.

# Rosalind: BA10D — Compute the Probability of a String Emitted by an HMM
# https://rosalind.info/problems/ba10d/
#
# Given: A string x, its alphabet, the states of an HMM, and its transition and
# emission matrices.
# Return: Pr(x), summed over every hidden path.

let observed = "xzyyzzyzyy"

let model = {
    states: ["A", "B"],
    symbols: ["x", "y", "z"],
    transition: {
        A: { A: 0.303, B: 0.697 },
        B: { A: 0.831, B: 0.169 },
    },
    emission: {
        A: { x: 0.533, y: 0.065, z: 0.402 },
        B: { x: 0.342, y: 0.334, z: 0.324 },
    },
}

# There are 2^10 paths here and 2^n in general, so summing them one at a time is
# not an option for a real string. The forward algorithm collapses them: once two
# paths reach the same state at the same position, nothing that follows can tell
# them apart, so they can be added together and carried as one number.
let probability = hmm_likelihood(observed, model)

println("Result:   " + str(round(probability * 1e6, 6)) + "e-06")
println("Expected: 1.100551e-06")

fn test_ba10d_string_probability() {
    assert abs(probability - 1.1005510319694847e-06) < 1e-16,
        "BA10D: got " + str(probability)
    # Small enough to enumerate, so check the sum really is over all 1024 paths.
    let states = model.states
    let total = range(0, 1024) |> reduce(|running, mask| {
        let path = range(0, len(observed))
            |> map(|i| states[(mask / pow(2, i)) % 2 |> floor()])
            |> join("")
        running + hmm_path_probability(path, model)
                * hmm_emission_probability(observed, path, model)
    }, 0.0)
    assert abs(probability - total) < 1e-15,
        "BA10D: forward gives " + str(probability) + " but enumeration gives " + str(total)
    # And it must be at least as large as the single best path.
    let best = viterbi(observed, model) |> join("")
    let best_probability = hmm_path_probability(best, model)
                         * hmm_emission_probability(observed, best, model)
    assert probability > best_probability, "BA10D: the sum must exceed its largest term"
}

BA10J — Solve the Soft Decoding Problem

solvedbrowser + CLI Problem statement Open in the workbench Download .bl

Forward-backward, which answers a different question from Viterbi: the most likely state at each position need not lie on any single path the model can produce.

# Rosalind: BA10J — Solve the Soft Decoding Problem
# https://rosalind.info/problems/ba10j/
#
# Given: A string x, its alphabet, the states of an HMM, and its transition and
# emission matrices.
# Return: For each position, the probability of each state given all of x.

let observed = "zyxxxxyxzz"

let model = {
    states: ["A", "B"],
    symbols: ["x", "y", "z"],
    transition: {
        A: { A: 0.911, B: 0.089 },
        B: { A: 0.228, B: 0.772 },
    },
    emission: {
        A: { x: 0.356, y: 0.191, z: 0.453 },
        B: { x: 0.04,  y: 0.467, z: 0.493 },
    },
}

# Forward-backward, not Viterbi. Viterbi answers "which single path", this
# answers "which state here" — conditioned on the whole string, so a symbol near
# the end can revise a call made near the start. The two disagree in general, and
# the position-wise winners need not even form a path the model can produce.
let posterior = hmm_posterior(observed, model)

println("Result:")
println("  A       B")
for distribution in posterior {
    println("  " + str(round(distribution.A, 4)) + "  " + str(round(distribution.B, 4)))
}
println("Expected first row: 0.5438  0.4562")
println("Expected last row:  0.8167  0.1833")

fn test_ba10j_soft_decoding() {
    let expected_a = [0.5438, 0.6492, 0.9647, 0.9936, 0.9957,
                      0.9891, 0.9154, 0.964,  0.8737, 0.8167]
    assert len(posterior) == len(observed), "BA10J: one row per position"
    for i in range(0, len(expected_a)) {
        assert abs(posterior[i].A - expected_a[i]) < 5e-5,
            "BA10J: position " + str(i) + " gives " + str(posterior[i].A)
                + ", expected " + str(expected_a[i])
        # Each position is a distribution over the states.
        assert abs(posterior[i].A + posterior[i].B - 1.0) < 1e-12,
            "BA10J: row " + str(i) + " does not sum to one"
    }
}

BA10H — Estimate the Parameters of an HMM

solvedbrowser + CLI Problem statement Open in the workbench Download .bl

With the path given there is nothing to infer — the best estimate is the fraction of the time each move was made. A state the path never visits keeps a uniform row, which is the only choice that leaves it a distribution.

# Rosalind: BA10H — Estimate the Parameters of an HMM
# https://rosalind.info/problems/ba10h/
#
# Given: A string x, its alphabet, a path pi, and the states of an HMM whose
# transition and emission probabilities are unknown.
# Return: The matrices that maximise Pr(x, pi).

let observed = "yzzzyxzxxx"
let hidden_path = "BBABABABAB"

# Only the shape of the model is known, so that is all the skeleton carries. The
# matrices are what comes back.
let skeleton = {
    states: ["A", "B", "C"],
    symbols: ["x", "y", "z"],
}

# With the path given there is nothing to infer: the estimate that maximises
# Pr(x, pi) is just the fraction of the time each transition was taken and each
# symbol emitted. C never appears in the path, so its rows have nothing to count
# and come back uniform — the only choice that leaves them a distribution.
let learned = hmm_estimate(observed, hidden_path, skeleton)

fn show(matrix, rows, columns) {
    println("      " + join(columns, "       "))
    for name in rows {
        println("  " + name + "   " + (columns |> map(|c| str(round(matrix[name][c], 3))) |> join("   ")))
    }
}

println("Transition:")
show(learned.transition, learned.states, learned.states)
println("Emission:")
show(learned.emission, learned.states, learned.symbols)
println("Expected transition row B: 0.8 0.2 0.0")
println("Expected emission row A:   0.25 0.25 0.5")

fn test_ba10h_parameter_estimation() {
    # B is followed by A four times out of five.
    assert abs(learned.transition.B.A - 0.8) < 5e-4, "BA10H: B->A is " + str(learned.transition.B.A)
    assert abs(learned.transition.B.B - 0.2) < 5e-4, "BA10H: B->B is " + str(learned.transition.B.B)
    assert abs(learned.transition.A.B - 1.0) < 5e-4, "BA10H: A->B is " + str(learned.transition.A.B)
    assert abs(learned.emission.A.z - 0.5) < 5e-4, "BA10H: A emits z at " + str(learned.emission.A.z)
    assert abs(learned.emission.B.y - 0.167) < 5e-4, "BA10H: B emits y at " + str(learned.emission.B.y)
    # An unvisited state keeps a usable row rather than a row of NaNs.
    assert abs(learned.transition.C.A - 0.333) < 5e-4, "BA10H: C's row should be uniform"
    # Every row is still a distribution.
    for name in learned.states {
        let total = learned.states |> map(|to| learned.transition[name][to]) |> sum()
        assert abs(total - 1.0) < 1e-9, "BA10H: transition row " + name + " sums to " + str(total)
    }
}

BA10I — Implement Viterbi Learning

solvedbrowser + CLI Problem statement Open in the workbench Download .bl

Decode, re-estimate as if that path were the truth, repeat. Climbs to a local optimum, so where it starts is part of the problem rather than an implementation detail.

# Rosalind: BA10I — Implement Viterbi Learning
# https://rosalind.info/problems/ba10i/
#
# Given: A number of iterations i, a string x, its alphabet, the states of an
# HMM, and initial transition and emission matrices.
# Return: Matrices that maximise Pr(x, pi) over all matrices and all paths pi.

let iterations = 100
let observed = "xxxzyzzxxzxyzxzxyxxzyzyzyyyyzzxxxzzxzyzzzxyxzzzxyzzxxxxzzzxyyxzzzzzyzzzxxzzxxxyxyzzyxzxxxyxzyxxyzyxz"

# Where this starts is part of the problem, not an implementation detail: the
# procedure climbs to a local optimum, and a different starting point reaches a
# different one.
let start = {
    states: ["A", "B"],
    symbols: ["x", "y", "z"],
    transition: {
        A: { A: 0.582, B: 0.418 },
        B: { A: 0.272, B: 0.728 },
    },
    emission: {
        A: { x: 0.129, y: 0.35,  z: 0.52  },
        B: { x: 0.422, y: 0.151, z: 0.426 },
    },
}

# Decode the most likely path under the current model, then re-estimate the model
# as if that path were the truth — which is BA10H — and repeat. Each round can
# only raise Pr(x, pi), so it settles.
let learned = hmm_viterbi_learning(observed, start, iterations)

println("Transition:")
println("      A       B")
for name in learned.states {
    println("  " + name + "   " + str(round(learned.transition[name].A, 3))
                     + "   " + str(round(learned.transition[name].B, 3)))
}
println("Emission:")
println("      x       y       z")
for name in learned.states {
    println("  " + name + "   " + (learned.symbols |> map(|s| str(round(learned.emission[name][s], 3))) |> join("   ")))
}
println("Expected transition: 0.875 0.125 / 0.011 0.989")
println("Expected emission:   0.0 0.75 0.25 / 0.402 0.174 0.424")

fn test_ba10i_viterbi_learning() {
    assert abs(learned.transition.A.A - 0.875) < 5e-4, "BA10I: A->A is " + str(learned.transition.A.A)
    assert abs(learned.transition.B.B - 0.989) < 5e-4, "BA10I: B->B is " + str(learned.transition.B.B)
    assert abs(learned.emission.A.x - 0.0)   < 5e-4, "BA10I: A emits x at " + str(learned.emission.A.x)
    assert abs(learned.emission.A.y - 0.75)  < 5e-4, "BA10I: A emits y at " + str(learned.emission.A.y)
    assert abs(learned.emission.B.z - 0.424) < 5e-4, "BA10I: B emits z at " + str(learned.emission.B.z)
    # Learning has to explain the data at least as well as the model it started
    # from — that is the property the whole procedure rests on.
    assert hmm_likelihood(observed, learned) >= hmm_likelihood(observed, start),
        "BA10I: learning made the observation less likely"
}

BA10K — Implement Baum-Welch Learning

solvedbrowser + CLI Problem statement Open in the workbench Download .bl

Expectation-maximisation: counts the expected number of times each transition was taken over every path at once, instead of committing to the best one. Its assertion checks the likelihood rises round by round, not only end to end.

# Rosalind: BA10K — Implement Baum-Welch Learning
# https://rosalind.info/problems/ba10k/
#
# Given: A number of iterations i, a string x, its alphabet, the states of an
# HMM, and initial transition and emission matrices.
# Return: Matrices estimated after i rounds of Baum-Welch learning.

let iterations = 10
let observed = "xzyyzyzyxy"

let start = {
    states: ["A", "B"],
    symbols: ["x", "y", "z"],
    transition: {
        A: { A: 0.019, B: 0.981 },
        B: { A: 0.668, B: 0.332 },
    },
    emission: {
        A: { x: 0.175, y: 0.003, z: 0.821 },
        B: { x: 0.196, y: 0.512, z: 0.293 },
    },
}

# Baum-Welch is expectation-maximisation for an HMM. Where BA10I commits to the
# single best path and counts along it, this counts the *expected* number of
# times each transition was taken across every path at once — which
# forward-backward supplies without enumerating any of them. Keeping the paths it
# would otherwise discard is what makes it the better estimator.
let learned = hmm_baum_welch(observed, start, iterations)

println("Transition:")
println("      A       B")
for name in learned.states {
    println("  " + name + "   " + str(round(learned.transition[name].A, 3))
                     + "   " + str(round(learned.transition[name].B, 3)))
}
println("Emission:")
println("      x       y       z")
for name in learned.states {
    println("  " + name + "   " + (learned.symbols |> map(|s| str(round(learned.emission[name][s], 3))) |> join("   ")))
}
println("Expected transition: 0.0 1.0 / 0.786 0.214")
println("Expected emission:   0.242 0.0 0.758 / 0.172 0.828 0.0")

fn test_ba10k_baum_welch() {
    assert abs(learned.transition.A.B - 1.0)   < 5e-4, "BA10K: A->B is " + str(learned.transition.A.B)
    assert abs(learned.transition.B.A - 0.786) < 5e-4, "BA10K: B->A is " + str(learned.transition.B.A)
    assert abs(learned.emission.A.x - 0.242) < 5e-4, "BA10K: A emits x at " + str(learned.emission.A.x)
    assert abs(learned.emission.A.z - 0.758) < 5e-4, "BA10K: A emits z at " + str(learned.emission.A.z)
    assert abs(learned.emission.B.y - 0.828) < 5e-4, "BA10K: B emits y at " + str(learned.emission.B.y)
    # Each round can only raise Pr(x). Checked round by round rather than only
    # end to end, because a single bad update can be hidden by later good ones.
    let running = range(1, 6) |> map(|n| hmm_likelihood(observed, hmm_baum_welch(observed, start, n)))
    for i in range(1, len(running)) {
        assert running[i] >= running[i - 1] - 1e-12,
            "BA10K: round " + str(i + 1) + " lowered the likelihood"
    }
    assert hmm_likelihood(observed, learned) > hmm_likelihood(observed, start),
        "BA10K: learning should explain the observation better than the start did"
}

BA10E — Construct a Profile HMM

solvedbrowser + CLI Problem statement Open in the workbench Download .bl

A family of sequences becomes something a new sequence can be scored against — what Pfam and HMMER search with. Conserved columns become match states; gappy ones become insertions, which keeps the model's length at the family's length rather than the alignment's.

# Rosalind: BA10E — Construct a Profile HMM
# https://rosalind.info/problems/ba10e/
#
# Given: A threshold theta, an alphabet, and a multiple alignment.
# Return: The transition and emission probabilities of HMM(Alignment, theta).

let threshold = 0.289
let alphabet = ["A", "B", "C", "D", "E"]
let alignment = [
    "EBA",
    "EBD",
    "EB-",
    "EED",
    "EBD",
    "EBE",
    "E-D",
    "EBD",
]

# A profile HMM turns a family of related sequences into something a new sequence
# can be scored against — it is what Pfam and HMMER search with. Each conserved
# column becomes a match state; the gappy ones become insertions, which is what
# keeps the model's length at the family's length rather than the alignment's.
#
# Here no column is gappy enough to cross the threshold, so all three are match
# columns and the model is three layers long.
let profile = hmm_profile(alignment, alphabet, threshold)

println("States: " + join(profile.states, " "))
println("")
println("Transitions that carry any probability:")
for source in profile.states {
    for target in profile.states {
        if profile.transition[source][target] > 0 {
            println("  " + source + " -> " + target + "   "
                    + str(round(profile.transition[source][target], 3)))
        }
    }
}
println("Expected: S->M1 1.0, M1->M2 0.875, M1->D2 0.125, M2->M3 0.857, M2->D3 0.143")

fn test_ba10e_profile_hmm() {
    assert len(profile.states) == 12, "BA10E: expected 12 states, got " + str(len(profile.states))
    assert profile.states[0] == "S" and profile.states[11] == "E", "BA10E: S and E bracket the model"

    assert abs(profile.transition.S.M1 - 1.0) < 5e-4, "BA10E: S->M1"
    assert abs(profile.transition.M1.M2 - 0.875) < 5e-4, "BA10E: M1->M2"
    assert abs(profile.transition.M1.D2 - 0.125) < 5e-4, "BA10E: M1->D2"
    assert abs(profile.transition.M2.M3 - 0.857) < 5e-4, "BA10E: M2->M3"
    assert abs(profile.transition.M2.D3 - 0.143) < 5e-4, "BA10E: M2->D3"
    assert abs(profile.transition.D2.M3 - 1.0) < 5e-4, "BA10E: D2->M3"
    assert abs(profile.transition.M3.E - 1.0) < 5e-4, "BA10E: M3->E"
    assert abs(profile.transition.D3.E - 1.0) < 5e-4, "BA10E: D3->E"

    assert abs(profile.emission.M1.E - 1.0) < 5e-4, "BA10E: M1 emits E"
    assert abs(profile.emission.M2.B - 0.857) < 5e-4, "BA10E: M2 emits B"
    assert abs(profile.emission.M3.D - 0.714) < 5e-4, "BA10E: M3 emits D"

    # Without pseudocounts, a state the alignment never reaches keeps an empty
    # row instead of a uniform one.
    let out_of_i0 = profile.states |> map(|to| profile.transition.I0[to]) |> sum()
    assert out_of_i0 == 0, "BA10E: I0 is never used, so it should have no transitions"
    # Deletion states are silent.
    let emitted_by_d1 = alphabet |> map(|s| profile.emission.D1[s]) |> sum()
    assert emitted_by_d1 == 0, "BA10E: D1 is a deletion state and cannot emit"
}

BA10F — Construct a Profile HMM with Pseudocounts

solvedbrowser + CLI Problem statement Open in the workbench Download .bl

Without a pseudocount, anything six sequences never happened to do is scored as impossible. It is added after the counts become probabilities, not before — added to raw counts its influence would depend on how many sequences the alignment contains.

# Rosalind: BA10F — Construct a Profile HMM with Pseudocounts
# https://rosalind.info/problems/ba10f/
#
# Given: A threshold theta, a pseudocount sigma, an alphabet, and a multiple
# alignment.
# Return: The transition and emission probabilities of HMM(Alignment, theta, sigma).

let threshold = 0.358
let pseudocount = 0.01
let alphabet = ["A", "B", "C", "D", "E"]
let alignment = [
    "ADA",
    "ADA",
    "AAA",
    "ADC",
    "-DA",
    "D-A",
]

# Without a pseudocount, anything the alignment never happened to do is scored as
# impossible — so a new sequence differing in one position gets probability zero
# rather than a low score. Six sequences cannot rule out the rest of the family,
# and that is what the pseudocount corrects.
#
# It is added after the counts are turned into probabilities, not before: added
# to raw counts its influence would depend on how many sequences the alignment
# happens to contain, which is not something anyone means to tune.
let profile = hmm_profile(alignment, alphabet, threshold, pseudocount)

println("Transitions out of S, I0, M1, D1:")
for source in ["S", "I0", "M1", "D1"] {
    let row = ["I0", "M1", "D1", "I1", "M2", "D2"]
        |> map(|target| target + "=" + str(round(profile.transition[source][target], 3)))
        |> join("  ")
    println("  " + source + ":  " + row)
}
println("Expected S:   I0=0.01  M1=0.819  D1=0.172")
println("Expected I0:  I0=0.333  M1=0.333  D1=0.333")
println("Expected M1:  I1=0.01  M2=0.786")
println("Expected D1:  I1=0.01  M2=0.981")

fn test_ba10f_profile_hmm_with_pseudocounts() {
    assert abs(profile.transition.S.I0 - 0.01)  < 5e-4, "BA10F: S->I0"
    assert abs(profile.transition.S.M1 - 0.819) < 5e-4, "BA10F: S->M1"
    assert abs(profile.transition.S.D1 - 0.172) < 5e-4, "BA10F: S->D1"
    # A row with no counts smooths to uniform over what the topology allows —
    # three states, not all twelve.
    assert abs(profile.transition.I0.I0 - 0.333) < 5e-4, "BA10F: I0->I0"
    assert abs(profile.transition.I0.M1 - 0.333) < 5e-4, "BA10F: I0->M1"
    assert abs(profile.transition.I0.D1 - 0.333) < 5e-4, "BA10F: I0->D1"
    assert abs(profile.transition.M1.I1 - 0.01)  < 5e-4, "BA10F: M1->I1"
    assert abs(profile.transition.M1.M2 - 0.786) < 5e-4, "BA10F: M1->M2"
    assert abs(profile.transition.D1.M2 - 0.981) < 5e-4, "BA10F: D1->M2"

    assert abs(profile.emission.I0.A - 0.2)   < 5e-4, "BA10F: I0 emits A"
    assert abs(profile.emission.M1.A - 0.771) < 5e-4, "BA10F: M1 emits A"
    assert abs(profile.emission.M1.B - 0.01)  < 5e-4, "BA10F: M1 emits B"
    assert abs(profile.emission.M2.D - 0.771) < 5e-4, "BA10F: M2 emits D"

    # A pseudocount does not make a silent state emit, and does not open
    # transitions the topology forbids — smoothing those would invent paths the
    # model does not have.
    let emitted_by_d1 = alphabet |> map(|s| profile.emission.D1[s]) |> sum()
    assert emitted_by_d1 == 0, "BA10F: D1 is a deletion state and cannot emit"
    assert profile.transition.S.M2 == 0, "BA10F: S cannot skip a layer to M2"
    assert profile.transition.M2.M1 == 0, "BA10F: a profile HMM cannot go backwards"
}

BA10G — Perform a Multiple Sequence Alignment with a Profile HMM

solvedbrowser + CLI Problem statement Open in the workbench Download .bl

Viterbi cannot do this: deletion states are silent, so nine states emit seven symbols. The silent states have to be settled in layer order at each position before the emitting ones look back at them.

# Rosalind: BA10G — Perform a Multiple Sequence Alignment with a Profile HMM
# https://rosalind.info/problems/ba10g/
#
# Given: A string Text, a multiple alignment, a threshold theta, and a
# pseudocount sigma.
# Return: An optimal hidden path emitting Text in HMM(Alignment, theta, sigma).

let text = "AEFDFDC"
let threshold = 0.4
let pseudocount = 0.01
let alphabet = ["A", "B", "C", "D", "E", "F"]
let alignment = [
    "ACDEFACADF",
    "AFDA---CCF",
    "A--EFD-FDC",
    "ACAEF--A-C",
    "ADDEFAAADF",
]

# This is what a profile HMM is for: having learned a family from an alignment,
# align a new sequence to the family rather than to any one of its members.
let profile = hmm_profile(alignment, alphabet, threshold, pseudocount)

# Not `viterbi`, and not because of a naming preference. Deletion states emit
# nothing, so the path is longer than the string it explains — nine states here
# for seven symbols. Ordinary Viterbi advances one state per symbol and cannot
# express that, so the silent states have to be settled in layer order at each
# position before the emitting ones look back at them.
let path = hmm_profile_align(text, profile)

println("Result:   " + join(path, " "))
println("Expected: M1 D2 D3 M4 M5 I5 M6 M7 M8")

fn test_ba10g_align_to_profile() {
    assert join(path, " ") == "M1 D2 D3 M4 M5 I5 M6 M7 M8", "BA10G: got " + join(path, " ")
    # Exactly the emitting states account for the string; the two deletions are
    # the difference between the path's length and the text's.
    let emitting = path |> filter(|state| starts_with(state, "M") or starts_with(state, "I"))
    assert len(emitting) == len(text),
        "BA10G: " + str(len(emitting)) + " emitting states for " + str(len(text)) + " symbols"
    assert len(path) > len(text), "BA10G: the silent states should make the path longer"
}

BA2D — Implement GreedyMotifSearch

solvedbrowser + CLI Problem statement Open in the workbench Download .bl

Greedy in the strict sense: each string picks what the current profile likes best and nothing is reconsidered. Fast, and wrong often enough that BA2E exists.

# Rosalind: BA2D — Implement GreedyMotifSearch
# https://rosalind.info/problems/ba2d/
#
# Given: Integers k and t, followed by a collection of strings Dna.
# Return: A collection BestMotifs resulting from GreedyMotifSearch(Dna, k, t).
# Where several profile-most probable k-mers tie, take the first.

let k = 3
let t = 5
let sequences = [
    "GGCGTTCAGGCA",
    "AAGAATCAGTCA",
    "CAAGGAGTTCGC",
    "CACGTCAATCAC",
    "CAATAATATTCG",
]

# Greedy in the strict sense: try every k-mer of the first string as a seed, then
# let each later string pick whatever its current profile likes best, never
# reconsidering. Fast, and wrong often enough that BA2E exists to fix it.
fn greedy_motifs(strings, width, pseudocount) {
    let best = strings |> map(|s| substr(s, 0, width))
    let first = strings[0]
    for start in range(0, len(first) - width + 1) {
        let motifs = [substr(first, start, width)]
        for i in range(1, len(strings)) {
            let profile = motif_profile(motifs, pseudocount)
            motifs = push(motifs, profile_most_probable(strings[i], width, profile))
        }
        if motif_score(motifs) < motif_score(best) {
            best = motifs
        }
    }
    best
}

let best_motifs = greedy_motifs(sequences, k, 0)

println("Result:")
for motif in best_motifs { println("  " + motif) }
println("Expected: CAG CAG CAA CAA CAA")

fn test_ba2d_greedy_motif_search() {
    assert join(best_motifs, " ") == "CAG CAG CAA CAA CAA",
        "BA2D: got " + join(best_motifs, " ")
    assert len(best_motifs) == t, "BA2D: one motif per string"
    # Every motif has to actually occur in its own string.
    for i in range(0, len(sequences)) {
        assert contains(sequences[i], best_motifs[i]),
            "BA2D: " + best_motifs[i] + " is not in " + sequences[i]
    }
}

BA2E — Implement GreedyMotifSearch with Pseudocounts

solvedbrowser + CLI Problem statement Open in the workbench Download .bl

One number different from BA2D. Without a pseudocount a base absent from a column makes every k-mer containing it impossible rather than unlikely. On this five-string sample the two versions actually tie at a score of 2 — the assertion says so rather than claiming an improvement the data does not show.

# Rosalind: BA2E — Implement GreedyMotifSearch with Pseudocounts
# https://rosalind.info/problems/ba2e/
#
# Given: Integers k and t, followed by a collection of strings Dna.
# Return: BestMotifs from GreedyMotifSearch(Dna, k, t) with pseudocounts.

let k = 3
let t = 5
let sequences = [
    "GGCGTTCAGGCA",
    "AAGAATCAGTCA",
    "CAAGGAGTTCGC",
    "CACGTCAATCAC",
    "CAATAATATTCG",
]

# The same greedy loop as BA2D, changing one number. Without a pseudocount a base
# absent from a column has probability zero, so any k-mer containing it is
# impossible rather than merely unlikely — one unlucky column silently discards
# every candidate, and the search follows whichever k-mer happened to come first.
# Laplace's rule of succession fixes it by adding one to every count.
fn greedy_motifs_smoothed(strings, width, pseudocount) {
    let best = strings |> map(|s| substr(s, 0, width))
    let first = strings[0]
    for start in range(0, len(first) - width + 1) {
        let motifs = [substr(first, start, width)]
        for i in range(1, len(strings)) {
            let profile = motif_profile(motifs, pseudocount)
            motifs = push(motifs, profile_most_probable(strings[i], width, profile))
        }
        if motif_score(motifs) < motif_score(best) {
            best = motifs
        }
    }
    best
}

let best_motifs = greedy_motifs_smoothed(sequences, k, 1)

println("Result:")
for motif in best_motifs { println("  " + motif) }
println("Expected: TTC ATC TTC ATC TTC")

fn test_ba2e_greedy_motif_search_with_pseudocounts() {
    assert join(best_motifs, " ") == "TTC ATC TTC ATC TTC",
        "BA2E: got " + join(best_motifs, " ")
    for i in range(0, len(sequences)) {
        assert contains(sequences[i], best_motifs[i]),
            "BA2E: " + best_motifs[i] + " is not in " + sequences[i]
    }
    # Worth being exact about: on this five-string sample the smoothed answer
    # does *not* beat BA2D's, it ties with it — both disagree in two places. The
    # pseudocount changes which motifs are found, and pays off on inputs large
    # enough for a zero to wipe out a good candidate; a toy sample does not show
    # that, and claiming otherwise here would be checking a wish.
    let without_pseudocounts = ["CAG", "CAG", "CAA", "CAA", "CAA"]
    assert motif_score(best_motifs) == 2, "BA2E: expected a score of 2"
    assert motif_score(without_pseudocounts) == 2, "BA2D's answer also scores 2"
    assert join(best_motifs, " ") != join(without_pseudocounts, " "),
        "BA2E: the pseudocount should at least change which motifs are chosen"
}

BA2F — Implement RandomizedMotifSearch

solvedbrowser + CLI Problem statement Open in the workbench Download .bl

Seeded so the example is reproducible. Graded on the score reached rather than on one particular set, because several distinct sets tie at the optimum of 9 — asserting on the published one would be asserting on the seed.

# Rosalind: BA2F — Implement RandomizedMotifSearch
# https://rosalind.info/problems/ba2f/
#
# Given: Integers k and t, followed by a collection of strings Dna.
# Return: The best motifs found over 1000 runs of RandomizedMotifSearch.

let k = 8
let t = 5
let sequences = [
    "CGCCCCTCTCGGGGGTGTTCAGTAAACGGCCA",
    "GGGCGAGGTATGTGTAAGTGCCAAGGTGCCAG",
    "TAGTACCGAGACCGAAAGAAGTATACAGGCGT",
    "TAGATCAAGTTTCAGGTGCACGTCGGTGAACC",
    "AATCCACCAGCTCCACGTGCAATGTTGGCCTA",
]

# Seeded, so this example gives the same answer every time it is run. The
# algorithm is genuinely random; only the reporting is pinned.
set_seed(20260803)

# Start from k-mers chosen at random, then repeatedly rebuild the profile and let
# every string re-pick against it. Each round can only lower the score, so it
# stops as soon as one does not — a local optimum, and usually a poor one, which
# is why the whole thing is thrown away and restarted a thousand times.
fn one_random_run(strings, width) {
    let motifs = strings |> map(|s| {
        let start = random_int(0, len(s) - width + 1)
        substr(s, start, width)
    })
    let best = motifs
    let improving = true
    while improving {
        let profile = motif_profile(motifs, 1)
        motifs = strings |> map(|s| profile_most_probable(s, width, profile))
        if motif_score(motifs) < motif_score(best) {
            best = motifs
        } else {
            improving = false
        }
    }
    best
}

let best_motifs = one_random_run(sequences, k)
for _ in range(1, 1000) {
    let attempt = one_random_run(sequences, k)
    if motif_score(attempt) < motif_score(best_motifs) {
        best_motifs = attempt
    }
}

println("Result:")
for motif in best_motifs { println("  " + motif) }
println("Score: " + str(motif_score(best_motifs)))
println("Expected (one optimal answer): TCTCGGGG CCAAGGTG TACAGGCG TTCAGGTG TCCACGTG")
println("which also scores 9 — several distinct motif sets tie at the optimum here")

fn test_ba2f_randomized_motif_search() {
    # A randomized search is graded on the score it reaches, not on returning one
    # particular set — several sets tie at the optimum, and asserting on the
    # published one would be asserting on this seed.
    let published = ["TCTCGGGG", "CCAAGGTG", "TACAGGCG", "TTCAGGTG", "TCCACGTG"]
    assert motif_score(best_motifs) <= motif_score(published),
        "BA2F: scored " + str(motif_score(best_motifs))
            + " against the published " + str(motif_score(published))
    assert len(best_motifs) == t, "BA2F: one motif per string"
    for i in range(0, len(sequences)) {
        assert contains(sequences[i], best_motifs[i]),
            "BA2F: " + best_motifs[i] + " is not in string " + str(i)
        assert len(best_motifs[i]) == k, "BA2F: every motif is k long"
    }
}

BA2G — Implement GibbsSampler

solvedbrowser + CLI Problem statement Open in the workbench Download .bl

Replaces one motif at a time rather than all of them, and draws in proportion to probability instead of taking the best — which is what lets it leave a local optimum. Rosalind's suggested 20 starts settles at 10 here; 200 reaches the optimal 9.

# Rosalind: BA2G — Implement GibbsSampler
# https://rosalind.info/problems/ba2g/
#
# Given: Integers k, t and N, followed by a collection of strings Dna.
# Return: The best motifs found over 20 random starts of GibbsSampler.

let k = 8
let t = 5
let iterations = 100
let sequences = [
    "CGCCCCTCTCGGGGGTGTTCAGTAAACGGCCA",
    "GGGCGAGGTATGTGTAAGTGCCAAGGTGCCAG",
    "TAGTACCGAGACCGAAAGAAGTATACAGGCGT",
    "TAGATCAAGTTTCAGGTGCACGTCGGTGAACC",
    "AATCCACCAGCTCCACGTGCAATGTTGGCCTA",
]

set_seed(20260803)

fn all_except(items, index) {
    range(0, len(items)) |> filter(|i| i != index) |> map(|i| items[i])
}

# Not the most probable k-mer, but one drawn in proportion to its probability.
# That is the whole difference from BA2F: always taking the best makes the search
# unable to leave a local optimum, whereas sometimes taking a worse k-mer lets it
# climb back out.
fn profile_random_kmer(text, width, profile) {
    let weights = range(0, len(text) - width + 1)
        |> map(|start| profile_probability(substr(text, start, width), profile))
    let total = sum(weights)
    let target = random() * total
    let running = 0.0
    let chosen = len(weights) - 1
    for i in range(0, len(weights)) {
        running = running + weights[i]
        if running >= target and chosen == len(weights) - 1 and i < len(weights) - 1 {
            chosen = i
        }
    }
    substr(text, chosen, width)
}

# Where RandomizedMotifSearch replaces every motif at once, Gibbs replaces one at
# a time and leaves the rest standing. Changing less per step is what lets it
# keep a good partial answer instead of discarding it wholesale.
fn one_gibbs_run(strings, width, rounds) {
    let motifs = strings |> map(|s| {
        let start = random_int(0, len(s) - width + 1)
        substr(s, start, width)
    })
    let best = motifs
    for _ in range(0, rounds) {
        let i = random_int(0, len(strings))
        let profile = motif_profile(all_except(motifs, i), 1)
        motifs[i] = profile_random_kmer(strings[i], width, profile)
        if motif_score(motifs) < motif_score(best) {
            best = motifs
        }
    }
    best
}

# Rosalind suggests 20 random starts. That is a floor, not a guarantee: with 20
# this sample settles at a score of 10 rather than the optimal 9, because Gibbs
# changes one motif at a time and a bad start takes many rounds to escape. More
# starts is the knob that fixes it, and 200 finds the optimum here.
let best_motifs = one_gibbs_run(sequences, k, iterations)
for _ in range(1, 200) {
    let attempt = one_gibbs_run(sequences, k, iterations)
    if motif_score(attempt) < motif_score(best_motifs) {
        best_motifs = attempt
    }
}

println("Result:")
for motif in best_motifs { println("  " + motif) }
println("Score: " + str(motif_score(best_motifs)))
println("Expected (one optimal answer): TCTCGGGG CCAAGGTG TACAGGCG TTCAGGTG TCCACGTG, score 9")

fn test_ba2g_gibbs_sampler() {
    # Graded on the score reached, not on one particular set — as in BA2F,
    # several sets can tie. With the seed pinned above this run happens to
    # recover the published motifs exactly, which the output shows.
    let published = ["TCTCGGGG", "CCAAGGTG", "TACAGGCG", "TTCAGGTG", "TCCACGTG"]
    assert motif_score(best_motifs) <= motif_score(published),
        "BA2G: scored " + str(motif_score(best_motifs))
            + " against the published " + str(motif_score(published))
    assert len(best_motifs) == t, "BA2G: one motif per string"
    for i in range(0, len(sequences)) {
        assert contains(sequences[i], best_motifs[i]),
            "BA2G: " + best_motifs[i] + " is not in string " + str(i)
        assert len(best_motifs[i]) == k, "BA2G: every motif is k long"
    }
}

BA3F — Find an Eulerian Cycle in a Graph

solvedbrowser + CLI Problem statement Open in the workbench Download .bl

Hierholzer's algorithm, linear in the edges. Asserted on the property — every edge used exactly once, every step a real edge — rather than on the published string, which is one rotation among many.

# Rosalind: BA3F — Find an Eulerian Cycle in a Graph
# https://rosalind.info/problems/ba3f/
#
# Given: An Eulerian directed graph, as an adjacency list.
# Return: An Eulerian cycle in the graph.

let adjacency = {
    "0": ["3"],
    "1": ["0"],
    "2": ["1", "6"],
    "3": ["2"],
    "4": ["2"],
    "5": ["4"],
    "6": ["5", "8"],
    "7": ["9"],
    "8": ["7"],
    "9": ["6"],
}

# Hierholzer's algorithm: walk until stuck — which in a balanced graph can only
# happen back where you started — then re-enter at a node with edges left and
# splice the new loop into the walk. Linear in the edges, against the factorial
# cost of searching for the walk directly.
let cycle = eulerian_cycle(adjacency, "6")

println("Result:   " + join(cycle, "->"))
println("Expected: 6->8->7->9->6->5->4->2->1->0->3->2->6")
println("(any Eulerian cycle is accepted — this is one rotation among many)")

fn test_ba3f_eulerian_cycle() {
    assert cycle[0] == cycle[len(cycle) - 1], "BA3F: a cycle must return to its start"

    # The real check is the property, not the published string: every edge used
    # exactly once, and every step a real edge.
    let edge_count = keys(adjacency) |> map(|node| len(adjacency[node])) |> sum()
    assert len(cycle) == edge_count + 1,
        "BA3F: " + str(len(cycle) - 1) + " steps for " + str(edge_count) + " edges"

    let seen = {}
    for i in range(0, len(cycle) - 1) {
        let step = cycle[i] + "->" + cycle[i + 1]
        assert contains(adjacency[cycle[i]], cycle[i + 1]), "BA3F: " + step + " is not an edge"
        assert contains(keys(seen), step) == false, "BA3F: " + step + " is used twice"
        seen[step] = true
    }
    assert len(keys(seen)) == edge_count, "BA3F: not every edge was used"
}

BA3G — Find an Eulerian Path in a Graph

solvedbrowser + CLI Problem statement Open in the workbench Download .bl

Add the edge between the two unbalanced nodes, find a cycle, then cut the added edge out again. Which node the walk starts and ends at is forced by the degrees, so those are asserted exactly.

# Rosalind: BA3G — Find an Eulerian Path in a Graph
# https://rosalind.info/problems/ba3g/
#
# Given: A directed graph containing an Eulerian path, as an adjacency list.
# Return: An Eulerian path in the graph.

let adjacency = {
    "0": ["2"],
    "1": ["3"],
    "2": ["1"],
    "3": ["0", "4"],
    "6": ["3", "7"],
    "7": ["8"],
    "8": ["9"],
    "9": ["6"],
}

# A path rather than a cycle, so the walk need not come back. At most one node
# may have an extra edge out — that is where it has to start — and at most one an
# extra edge in, where it has to end. Adding the edge between them makes the
# graph balanced, which turns this into BA3F; the added edge is then cut out
# again, and the walk begins on the far side of the cut.
let path = eulerian_path(adjacency)

println("Result:   " + join(path, "->"))
println("Expected: 6->7->8->9->6->3->0->2->1->3->4")

fn test_ba3g_eulerian_path() {
    # 6 has one more edge out than in, and 4 one more in than out, so the walk is
    # forced to start and end there — that part is not a matter of taste.
    assert path[0] == "6", "BA3G: must start at 6, got " + path[0]
    assert path[len(path) - 1] == "4", "BA3G: must end at 4, got " + path[len(path) - 1]

    let edge_count = keys(adjacency) |> map(|node| len(adjacency[node])) |> sum()
    assert len(path) == edge_count + 1,
        "BA3G: " + str(len(path) - 1) + " steps for " + str(edge_count) + " edges"

    let seen = {}
    for i in range(0, len(path) - 1) {
        let step = path[i] + "->" + path[i + 1]
        assert contains(adjacency[path[i]], path[i + 1]), "BA3G: " + step + " is not an edge"
        assert contains(keys(seen), step) == false, "BA3G: " + step + " is used twice"
        seen[step] = true
    }
    assert len(keys(seen)) == edge_count, "BA3G: not every edge was used"
}

BA3H — Reconstruct a String from its k-mer Composition

solvedbrowser + CLI Problem statement Open in the workbench Download .bl

Reads become edges, not nodes — which makes assembly an Eulerian path, solvable in linear time. Reads as nodes would give a Hamiltonian path instead: the same data, a different graph, and the difference between tractable and NP-hard.

# Rosalind: BA3H — Reconstruct a String from its k-mer Composition
# https://rosalind.info/problems/ba3h/
#
# Given: An integer k, followed by a list of k-mers Patterns.
# Return: A string Text whose k-mer composition is Patterns.

let k = 4
let patterns = ["CTTA", "ACCA", "TACC", "GGCT", "GCTT", "TTAC"]

# Genome assembly, in miniature. Each k-mer becomes an *edge* from its prefix to
# its suffix — not a node — because then using every read exactly once is
# precisely an Eulerian path, which BA3G already solves in linear time. Making
# reads the nodes instead gives a Hamiltonian path, which is NP-hard: the same
# data, a different graph, and the difference between tractable and not.
let de_bruijn = {}
for pattern in patterns {
    let prefix = substr(pattern, 0, k - 1)
    let suffix = substr(pattern, 1, k - 1)
    if contains(keys(de_bruijn), prefix) {
        de_bruijn[prefix] = push(de_bruijn[prefix], suffix)
    } else {
        de_bruijn[prefix] = [suffix]
    }
}

let path = eulerian_path(de_bruijn)

# Spell the path: the first node in full, then one new character per step.
let text = path[0] + (range(1, len(path))
    |> map(|i| substr(path[i], k - 2, 1))
    |> join(""))

println("Result:   " + text)
println("Expected: GGCTTACCA")

fn test_ba3h_string_reconstruction() {
    assert text == "GGCTTACCA", "BA3H: got " + text
    assert len(text) == len(patterns) + k - 1, "BA3H: n reads of length k spell n + k - 1"
    # The real requirement: the answer's k-mer composition is the input, as a
    # multiset. Sorting both is enough since every read is used once.
    let composition = range(0, len(text) - k + 1) |> map(|i| substr(text, i, k))
    assert sort(composition) == sort(patterns),
        "BA3H: composition " + str(sort(composition)) + " != " + str(sort(patterns))
}

BA3I — Find a k-Universal Circular String

solvedbrowser + CLI Problem statement Open in the workbench Download .bl

Every (k-1)-mer has two edges in and two out, so the graph is balanced and the walk closes. Returns a different valid string from the published one; the assertion reads around the circle and checks all 2^k k-mers appear exactly once.

# Rosalind: BA3I — Find a k-Universal Circular String
# https://rosalind.info/problems/ba3i/
#
# Given: An integer k.
# Return: A k-universal circular binary string — one containing every binary
# k-mer exactly once when read around the circle.

let k = 4

# Every binary k-mer, in order: 0000, 0001, ... 1111.
fn binary_kmers(width) {
    let patterns = [""]
    for _ in range(0, width) {
        patterns = patterns |> flat_map(|prefix| [prefix + "0", prefix + "1"])
    }
    patterns
}

let patterns = binary_kmers(k)

# The same de Bruijn construction as BA3H, but here every (k-1)-mer has exactly
# two edges in and two out, so the graph is balanced and the walk closes into a
# cycle. A circular string of length 2^k containing all 2^k k-mers is only
# possible because each one overlaps the next by k-1 — the cycle is what makes
# that packing exist at all.
let de_bruijn = {}
for pattern in patterns {
    let prefix = substr(pattern, 0, k - 1)
    let suffix = substr(pattern, 1, k - 1)
    if contains(keys(de_bruijn), prefix) {
        de_bruijn[prefix] = push(de_bruijn[prefix], suffix)
    } else {
        de_bruijn[prefix] = [suffix]
    }
}

let cycle = eulerian_cycle(de_bruijn, patterns[0] |> substr(0, k - 1))

# Spelling a *circular* string drops the last k-1 characters, because they are
# the first k-1 come round again.
let spelled = cycle[0] + (range(1, len(cycle))
    |> map(|i| substr(cycle[i], k - 2, 1))
    |> join(""))
let text = substr(spelled, 0, len(spelled) - (k - 1))

println("Result:   " + text)
println("Expected: 0000110010111101  (any k-universal string is accepted)")

fn test_ba3i_k_universal_circular_string() {
    assert len(text) == pow(2, k), "BA3I: a k-universal binary string has length 2^k"
    # Read around the circle: every binary k-mer exactly once.
    let wrapped = text + substr(text, 0, k - 1)
    let found = range(0, len(text)) |> map(|i| substr(wrapped, i, k))
    assert len(unique(found)) == pow(2, k), "BA3I: a k-mer appears twice"
    assert sort(found) == sort(patterns), "BA3I: not every k-mer appears"
}

BA3J — Reconstruct a String from its Paired Composition

solvedbrowser + CLI Problem statement Open in the workbench Download .bl

Paired reads pin down a repeat that either read alone would be ambiguous inside. The two halves must agree wherever they overlap, and checking that agreement is what makes a wrong assembly detectable.

# Rosalind: BA3J — Reconstruct a String from its Paired Composition
# https://rosalind.info/problems/ba3j/
#
# Given: Integers k and d, followed by a collection of (k,d)-mers.
# Return: A string whose (k,d)-mer composition is the given collection.

let k = 4
let d = 2
let pairs = [
    "GAGA|TTGA", "TCGT|GATG", "CGTG|ATGT", "TGGT|TGAG", "GTGA|TGTT",
    "GTGG|GTGA", "TGAG|GTTG", "GGTC|GAGA", "GTCG|AGAT",
]

# Paired reads carry information plain k-mers do not: two short reads a known
# distance apart pin down a repeat that either one alone would be ambiguous
# inside. The graph is built the same way as BA3H, on pairs rather than single
# k-mers — the prefix of a pair is the prefix of both halves.
fn halves(pair) { split(pair, "|") }

let de_bruijn = {}
for pair in pairs {
    let parts = halves(pair)
    let prefix = substr(parts[0], 0, k - 1) + "|" + substr(parts[1], 0, k - 1)
    let suffix = substr(parts[0], 1, k - 1) + "|" + substr(parts[1], 1, k - 1)
    if contains(keys(de_bruijn), prefix) {
        de_bruijn[prefix] = push(de_bruijn[prefix], suffix)
    } else {
        de_bruijn[prefix] = [suffix]
    }
}

let path = eulerian_path(de_bruijn)

# Spell each half separately, then overlap them. The two spellings must agree
# wherever they overlap — that agreement is the extra constraint the pairing
# buys, and checking it is what makes a wrong assembly detectable.
fn spell(nodes, which, width) {
    let first = halves(nodes[0])[which]
    first + (range(1, len(nodes)) |> map(|i| substr(halves(nodes[i])[which], width - 2, 1)) |> join(""))
}

let first_spelled = spell(path, 0, k)
let second_spelled = spell(path, 1, k)
let gap = k + d

let overlap_disagrees = range(gap, len(first_spelled))
    |> filter(|i| substr(first_spelled, i, 1) != substr(second_spelled, i - gap, 1))

let text = first_spelled + substr(second_spelled, len(second_spelled) - gap, gap)

println("Result:   " + text)
println("Expected: GTGGTCGTGAGATGTTGA")

fn test_ba3j_paired_reconstruction() {
    assert text == "GTGGTCGTGAGATGTTGA", "BA3J: got " + text
    assert len(overlap_disagrees) == 0,
        "BA3J: the two spellings disagree at " + str(overlap_disagrees)
    assert len(text) == len(pairs) + 2 * k + d - 1,
        "BA3J: n pairs spell n + 2k + d - 1 characters"
    # And the answer's own paired composition is the input.
    let composition = range(0, len(text) - (2 * k + d) + 1)
        |> map(|i| substr(text, i, k) + "|" + substr(text, i + k + d, k))
    assert sort(composition) == sort(pairs),
        "BA3J: composition does not match the reads"
}

BA4B — Find Substrings of a Genome Encoding a Given Amino Acid String

solvedbrowser + CLI Problem statement Open in the workbench Download .bl

A peptide can be encoded on either strand, so both are searched. ATGGCC appears twice and both occurrences count — the answer is substrings by position, not a set of distinct strings.

# Rosalind: BA4B — Find Substrings of a Genome Encoding a Given Amino Acid String
# https://rosalind.info/problems/ba4b/
#
# Given: A DNA string Text and an amino acid string Peptide.
# Return: All substrings of Text encoding Peptide.

let text = "ATGGCCATGGCCCCCAGAACTGAGATCAATAGTACCCGTATTAACGGGTGA"
let peptide = "MA"

# A peptide can be encoded on either strand, so both have to be searched. The
# reverse strand is read in the opposite direction, which is why the reverse
# complement is translated rather than the original read backwards.
let width = len(peptide) * 3

fn encodes(candidate, wanted) {
    let forward = str(translate(dna(candidate)))
    let backward = str(translate(reverse_complement(dna(candidate))))
    forward == wanted or backward == wanted
}

let found = range(0, len(text) - width + 1)
    |> map(|i| substr(text, i, width))
    |> filter(|candidate| encodes(candidate, peptide))

println("Result:")
for candidate in found { println("  " + candidate) }
println("Expected: ATGGCC GGCCAT ATGGCC")

fn test_ba4b_peptide_encoding() {
    assert join(found, " ") == "ATGGCC GGCCAT ATGGCC", "BA4B: got " + join(found, " ")
    # ATGGCC appears twice, and both occurrences count — the answer is a list of
    # substrings by position, not a set of distinct strings.
    assert len(found) == 3, "BA4B: expected 3 substrings"
    assert len(unique(found)) == 2, "BA4B: two of them are the same string"
    # GGCCAT is the one found on the reverse strand.
    assert str(translate(reverse_complement(dna("GGCCAT")))) == peptide,
        "BA4B: GGCCAT should encode MA on the reverse strand"
}

BA4C — Generate the Theoretical Spectrum of a Cyclic Peptide

solvedbrowser + CLI Problem statement Open in the workbench Download .bl

A cyclic peptide's fragments include those wrapping past the end, and each wrapping piece is the complement of a non-wrapping one. 242 appears twice because LE and QN both weigh it.

# Rosalind: BA4C — Generate the Theoretical Spectrum of a Cyclic Peptide
# https://rosalind.info/problems/ba4c/
#
# Given: An amino acid string Peptide.
# Return: Cyclospectrum(Peptide).

let peptide = "LEQN"

# A mass spectrometer breaks many copies of a peptide at every position and
# weighs the pieces. For a cyclic peptide the pieces include those that wrap past
# the end, so LEQN contributes QNL and NLE as well as the obvious subpeptides —
# and each wrapping piece is exactly the complement of a non-wrapping one.
let spectrum = cyclic_spectrum(peptide)

println("Result:   " + (spectrum |> map(|m| str(m)) |> join(" ")))
println("Expected: 0 113 114 128 129 227 242 242 257 355 356 370 371 484")

fn test_ba4c_cyclic_spectrum() {
    assert (spectrum |> map(|m| str(m)) |> join(" "))
        == "0 113 114 128 129 227 242 242 257 355 356 370 371 484",
        "BA4C: got " + str(spectrum)
    # A cyclic peptide of length n has n(n-1) proper subpeptides, plus 0 and the
    # whole peptide.
    let n = len(peptide)
    assert len(spectrum) == n * (n - 1) + 2,
        "BA4C: expected " + str(n * (n - 1) + 2) + " masses, got " + str(len(spectrum))
    assert spectrum[0] == 0, "BA4C: the empty piece weighs nothing"
    assert spectrum[len(spectrum) - 1] == peptide_mass(peptide),
        "BA4C: the heaviest piece is the whole peptide"
    # 242 twice is not a mistake: LE and QN both weigh 242, and a spectrum
    # records both.
    assert (spectrum |> count_if(|m| m == 242)) == 2, "BA4C: LE and QN both weigh 242"
}

BA4D — Compute the Number of Peptides of Given Total Mass

solvedbrowser + CLI Problem statement Open in the workbench Download .bl

Counted by building up from below rather than enumerated — listing 14.7 billion peptides to count them is not an option. Eighteen residue masses, not twenty, since I/L and K/Q collide.

# Rosalind: BA4D — Compute the Number of Peptides of Given Total Mass
# https://rosalind.info/problems/ba4d/
#
# Given: An integer m.
# Return: The number of linear peptides of integer mass m.

let target = 1024

# Every peptide of mass m is some peptide of mass m - r followed by a residue of
# mass r, so the counts build up from below and each is used many times. Counting
# by enumeration instead would mean listing 14.7 billion peptides to find out how
# many there are.
#
# Eighteen residue masses, not twenty: I/L and K/Q collide, and a peptide is
# counted by its masses.
let residues = amino_acid_masses()

let ways = [1]
for mass in range(1, target + 1) {
    let total = residues
        |> filter(|r| r <= mass)
        |> map(|r| ways[mass - r])
        |> sum()
    ways = push(ways, total)
}

println("Result:   " + str(ways[target]))
println("Expected: 14712706211")

fn test_ba4d_counting_peptides() {
    assert ways[target] == 14712706211, "BA4D: got " + str(ways[target])
    assert len(residues) == 18, "BA4D: 18 distinct masses, since I/L and K/Q collide"
    # The empty peptide is the one way to weigh nothing, and nothing weighs less
    # than the lightest residue.
    assert ways[0] == 1, "BA4D: one empty peptide"
    assert ways[56] == 0, "BA4D: nothing is lighter than glycine's 57"
    assert ways[57] == 1, "BA4D: glycine alone"
    assert ways[114] == 2, "BA4D: GG and N both weigh 114"
}

BA4E — Find a Cyclic Peptide with Theoretical Spectrum Matching an Ideal Spectrum

solvedbrowser + CLI Problem statement Open in the workbench Download .bl

Branch and bound: a candidate whose linear spectrum contains a mass the target lacks can never recover, since growing it only adds masses. That pruning is the whole algorithm — without it the search is 18^n.

# Rosalind: BA4E — Find a Cyclic Peptide with Theoretical Spectrum Matching an
# Ideal Spectrum
# https://rosalind.info/problems/ba4e/
#
# Given: An ideal experimental spectrum.
# Return: Every peptide whose cyclospectrum equals it, written as masses.

let spectrum = [0, 113, 128, 186, 241, 299, 314, 427]

# Branch and bound. Grow every candidate by one residue at a time, and throw away
# immediately any whose linear spectrum contains a mass the target does not —
# because adding residues can only add masses, so such a candidate can never
# recover. That pruning is the whole algorithm: without it this is 18^n.
let parent_mass = max(spectrum)
let residues = amino_acid_masses()

fn is_consistent(peptide, target) {
    let pieces = linear_spectrum(peptide)
    let remaining = target
    let ok = true
    for piece in pieces {
        if contains(remaining, piece) {
            remaining = remove_first(remaining, piece)
        } else {
            ok = false
        }
    }
    ok
}

# Drop one copy, not every copy: the spectrum is a multiset, and a candidate
# explaining a repeated mass once must not be credited with explaining it twice.
fn remove_first(items, wanted) {
    let index = (range(0, len(items)) |> filter(|i| items[i] == wanted))[0]
    range(0, len(items)) |> filter(|i| i != index) |> map(|i| items[i])
}

let candidates = [[]]
let matches = []
while len(candidates) > 0 {
    let grown = candidates |> flat_map(|peptide| residues |> map(|r| push(peptide, r)))
    candidates = []
    for peptide in grown {
        if sum(peptide) == parent_mass {
            if cyclic_spectrum(peptide) == sort(spectrum) {
                matches = push(matches, peptide)
            }
        } else {
            if is_consistent(peptide, spectrum) {
                candidates = push(candidates, peptide)
            }
        }
    }
}

let written = matches |> map(|p| p |> map(|m| str(m)) |> join("-")) |> sort()

println("Result:   " + join(written, " "))
println("Expected: 113-128-186 113-186-128 128-113-186 128-186-113 186-113-128 186-128-113")
println("(the same cycle written from each starting point and in both directions)")

fn test_ba4e_cyclopeptide_sequencing() {
    assert len(matches) == 6,
        "BA4E: expected 6 rotations and reflections, got " + str(len(matches))
    assert join(written, " ")
        == "113-128-186 113-186-128 128-113-186 128-186-113 186-113-128 186-128-113",
        "BA4E: got " + join(written, " ")
    # Every answer must reproduce the spectrum exactly, and weigh what it should.
    for peptide in matches {
        assert cyclic_spectrum(peptide) == sort(spectrum),
            "BA4E: " + str(peptide) + " does not reproduce the spectrum"
        assert sum(peptide) == parent_mass, "BA4E: wrong total mass"
    }
}

BA4F — Compute the Score of a Cyclic Peptide Against a Spectrum

solvedbrowser + CLI Problem statement Open in the workbench Download .bl

Real spectra are missing masses and contain spurious ones, so exact matching is unavailable. Multiplicity counts: set intersection would score a peptide explaining a repeated mass once as well as one explaining it fully.

# Rosalind: BA4F — Compute the Score of a Cyclic Peptide Against a Spectrum
# https://rosalind.info/problems/ba4f/
#
# Given: An amino acid string Peptide and a collection of integers Spectrum.
# Return: Score(Peptide, Spectrum).

let peptide = "NQEL"
let observed = [0, 99, 113, 114, 128, 227, 257, 299, 355, 356, 370, 371, 484]

# Real spectra are missing masses the peptide should produce and contain masses
# it should not — noise and incomplete fragmentation — so an exact match is not
# available and the question becomes how many masses agree.
#
# Multiplicity counts. A mass appearing twice in both spectra scores two; treating
# the spectra as sets would score a peptide that explains a repeated mass once as
# generously as one that explains it fully.
let score = spectrum_score(cyclic_spectrum(peptide), observed)

println("Result:   " + str(score))
println("Expected: 11")

fn test_ba4f_cyclopeptide_scoring() {
    assert score == 11, "BA4F: got " + str(score)
    # 99 is in the observed spectrum but not in the peptide's — that is the noise
    # the score has to tolerate.
    assert contains(observed, 99), "BA4F: the sample contains a mass NQEL cannot make"
    assert contains(cyclic_spectrum(peptide), 99) == false, "BA4F: NQEL makes no 99"
    # A peptide always scores fully against its own spectrum.
    let perfect = cyclic_spectrum(peptide)
    assert spectrum_score(perfect, perfect) == len(perfect),
        "BA4F: a spectrum should match itself completely"
}

BA4G — Implement LeaderboardCyclopeptideSequencing

solvedbrowser + CLI Problem statement Open in the workbench Download .bl

With a noisy spectrum nothing can be pruned for inconsistency — the right peptide will contain masses the spectrum lacks. Candidates survive on rank instead. Returns a reflection of the published answer; the assertion compares cyclic spectra, since a cycle has no distinguished start.

# Rosalind: BA4G — Implement LeaderboardCyclopeptideSequencing
# https://rosalind.info/problems/ba4g/
#
# Given: An integer N and a collection of integers Spectrum.
# Return: A peptide of maximum score against Spectrum, as masses.

let keep = 10
let observed = [0, 71, 113, 129, 147, 200, 218, 260, 313, 331, 347, 389, 460]

# BA4E needed a perfect spectrum. Real ones are noisy, so nothing can be pruned
# for being inconsistent — a correct peptide will contain masses the spectrum
# lacks. Instead every candidate survives on rank: grow them all, keep the best N
# by linear score, repeat. The leaderboard is what replaces the exact pruning.
let parent_mass = max(observed)
let residues = amino_acid_masses()

fn trim_to(board, spectrum, limit) {
    if len(board) <= limit { return board }
    let ranked = board
        |> map(|p| { peptide: p, score: spectrum_score(linear_spectrum(p), spectrum) })
        |> sort_by(|entry| 0 - entry.score)
    # Ties at the cutoff are all kept — dropping some arbitrarily can discard the
    # right answer while keeping an equally-scoring rival.
    let cutoff = ranked[limit - 1].score
    ranked |> filter(|entry| entry.score >= cutoff) |> map(|entry| entry.peptide)
}

let board = [[]]
let leader = []
let leader_score = 0
while len(board) > 0 {
    board = board |> flat_map(|peptide| residues |> map(|r| push(peptide, r)))
                  |> filter(|peptide| sum(peptide) <= parent_mass)
    for peptide in board {
        if sum(peptide) == parent_mass {
            # Scored cyclically here: a peptide of full mass *is* a cycle.
            let score = spectrum_score(cyclic_spectrum(peptide), observed)
            if score > leader_score {
                leader_score = score
                leader = peptide
            }
        }
    }
    board = trim_to(board, observed, keep)
}

let written = leader |> map(|m| str(m)) |> join("-")

println("Result:   " + written + "   score " + str(leader_score))
println("Expected: 113-147-71-129 (any rotation or reflection scores the same)")

fn test_ba4g_leaderboard_sequencing() {
    let published = [113, 147, 71, 129]
    assert leader_score == spectrum_score(cyclic_spectrum(published), observed),
        "BA4G: scored " + str(leader_score) + ", published scores "
            + str(spectrum_score(cyclic_spectrum(published), observed))
    assert sum(leader) == parent_mass, "BA4G: the answer must weigh the parent mass"
    # A cyclic peptide has no distinguished starting point, so the answer is
    # correct up to rotation and reflection — compare the spectra, not the lists.
    assert cyclic_spectrum(leader) == cyclic_spectrum(published),
        "BA4G: " + written + " is not a rotation of the published answer"
}

BA4H — Generate the Convolution of a Spectrum

solvedbrowser + CLI Problem statement Open in the workbench Download .bl

Differences between fragment masses are themselves residue masses, so the commonest ones are what the peptide is built from — recoverable without assuming the standard twenty.

# Rosalind: BA4H — Generate the Convolution of a Spectrum
# https://rosalind.info/problems/ba4h/
#
# Given: A collection of integers Spectrum.
# Return: The convolution, in decreasing order of multiplicity, each element
# repeated as many times as it occurs.

let spectrum = [0, 137, 186, 323]

# The difference between two fragment masses is the mass of whatever lies between
# them — which for fragments differing by one residue is that residue's mass. So
# the commonest differences are the peptide's own residues, recoverable without
# assuming the standard twenty. That is what makes BA4I able to sequence peptides
# containing modified residues.
let differences = spectrum_convolution(spectrum)

let by_multiplicity = differences
    |> unique()
    |> map(|value| { value: value, count: differences |> count_if(|d| d == value) })
    |> sort_by(|entry| 0 - entry.count)

let listed = by_multiplicity |> flat_map(|entry| range(0, entry.count) |> map(|_| str(entry.value)))

println("Result:   " + join(listed, " "))
println("Expected: 137 137 186 186 323 49")

fn test_ba4h_spectral_convolution() {
    # Any order among equal multiplicities is accepted, so the check is the
    # multiset and the ordering by count, not the exact string.
    assert sort(listed) == sort(["137", "137", "186", "186", "323", "49"]),
        "BA4H: got " + join(listed, " ")
    # 0 differences are excluded, and every element is positive.
    assert (differences |> count_if(|d| d <= 0)) == 0, "BA4H: differences must be positive"
    # 137 and 186 each arise twice: 137-0 and 323-186, 186-0 and 323-137.
    assert (differences |> count_if(|d| d == 137)) == 2, "BA4H: 137 occurs twice"
    assert (differences |> count_if(|d| d == 49)) == 1, "BA4H: 186 - 137 = 49, once"
    # Ordered by multiplicity, so nothing rarer precedes something commoner.
    for i in range(1, len(by_multiplicity)) {
        assert by_multiplicity[i].count <= by_multiplicity[i - 1].count,
            "BA4H: multiplicities must not increase"
    }
}

BA4I — Implement ConvolutionCyclopeptideSequencing

solvedbrowser + CLI Problem statement Open in the workbench Download .bl

The published answer contains a residue of mass 72, which is not an amino acid. That is the point: the alphabet is read off the data rather than assumed, so modified residues are findable. Returns a different peptide of equal score, which is all a noisy spectrum can distinguish.

# Rosalind: BA4I — Implement ConvolutionCyclopeptideSequencing
# https://rosalind.info/problems/ba4i/
#
# Given: Integers M and N, and a collection of integers Spectrum.
# Return: A cyclic peptide of maximum score, drawn from the M most frequent
# elements of the convolution between 57 and 200.

let take_masses = 20
let keep = 60
let observed = [57, 57, 71, 99, 129, 137, 170, 186, 194, 208, 228, 265,
                285, 299, 307, 323, 356, 364, 394, 422, 493]

# The published answer contains a residue of mass 72, which is not one of the
# twenty amino acids. That is the point of this problem: rather than assuming the
# standard alphabet, read the alphabet off the data. The commonest differences
# between fragment masses are the residues the peptide is actually built from,
# whatever they are — so a modified or non-standard residue is found rather than
# being impossible to represent.
#
# The 57-to-200 window is the plausible range for a single residue: glycine is
# the lightest at 57 and tryptophan the heaviest at 186.
let differences = spectrum_convolution(observed) |> filter(|d| d >= 57 and d <= 200)

let tallied = differences
    |> unique()
    |> map(|value| { value: value, count: differences |> count_if(|d| d == value) })
    |> sort_by(|entry| 0 - entry.count)

# Ties at the cutoff are kept, same reasoning as trimming the leaderboard.
let cutoff = tallied[take_masses - 1].count
let residues = tallied |> filter(|entry| entry.count >= cutoff) |> map(|entry| entry.value)

let parent_mass = max(observed)

fn trim_board(board, spectrum, limit) {
    if len(board) <= limit { return board }
    let ranked = board
        |> map(|p| { peptide: p, score: spectrum_score(linear_spectrum(p), spectrum) })
        |> sort_by(|entry| 0 - entry.score)
    let edge = ranked[limit - 1].score
    ranked |> filter(|entry| entry.score >= edge) |> map(|entry| entry.peptide)
}

let board = [[]]
let leader = []
let leader_score = 0
while len(board) > 0 {
    board = board |> flat_map(|peptide| residues |> map(|r| push(peptide, r)))
                  |> filter(|peptide| sum(peptide) <= parent_mass)
    for peptide in board {
        if sum(peptide) == parent_mass {
            let score = spectrum_score(cyclic_spectrum(peptide), observed)
            if score > leader_score {
                leader_score = score
                leader = peptide
            }
        }
    }
    board = trim_board(board, observed, keep)
}

let written = leader |> map(|m| str(m)) |> join("-")

println("Residues read off the data: " + (sort(residues) |> map(|m| str(m)) |> join(" ")))
println("Result:   " + written + "   score " + str(leader_score))
println("Expected: 99-71-137-57-72-57, which also scores 21 — a different peptide")
println("          of equal score, which is all a noisy spectrum can distinguish")

fn test_ba4i_convolution_sequencing() {
    let published = [99, 71, 137, 57, 72, 57]
    assert leader_score >= spectrum_score(cyclic_spectrum(published), observed),
        "BA4I: scored " + str(leader_score) + ", published scores "
            + str(spectrum_score(cyclic_spectrum(published), observed))
    assert sum(leader) == parent_mass, "BA4I: the answer must weigh the parent mass"
    # The alphabet has to include 72, which is not an amino acid mass — if it did
    # not, the published answer would be unreachable.
    assert contains(residues, 72), "BA4I: 72 should be read off the convolution"
    assert contains(amino_acid_masses(), 72) == false,
        "BA4I: and 72 is not a standard residue mass"
}

BA4J — Generate the Theoretical Spectrum of a Linear Peptide

solvedbrowser + CLI Problem statement Open in the workbench Download .bl

A strict subset of the cyclic spectrum. Both are needed because sequencing grows a peptide one residue at a time, and scoring a partial peptide cyclically would credit it with wrap-around fragments it does not have.

# Rosalind: BA4J — Generate the Theoretical Spectrum of a Linear Peptide
# https://rosalind.info/problems/ba4j/
#
# Given: An amino acid string Peptide.
# Return: LinearSpectrum(Peptide).

let peptide = "NQEL"

# The same idea as BA4C with the ends not joined, so nothing wraps. That makes
# the linear spectrum a strict subset of the cyclic one — which matters for
# sequencing, because a linear score can be computed for a partial peptide that
# is not yet a full cycle.
let spectrum = linear_spectrum(peptide)

println("Result:   " + (spectrum |> map(|m| str(m)) |> join(" ")))
println("Expected: 0 113 114 128 129 242 242 257 370 371 484")

fn test_ba4j_linear_spectrum() {
    assert (spectrum |> map(|m| str(m)) |> join(" "))
        == "0 113 114 128 129 242 242 257 370 371 484",
        "BA4J: got " + str(spectrum)
    # A linear peptide of length n has n(n+1)/2 subpeptides, plus the empty one.
    let n = len(peptide)
    assert len(spectrum) == n * (n + 1) / 2 + 1,
        "BA4J: expected " + str(n * (n + 1) / 2 + 1) + " masses"
    # And every one of them also appears in the cyclic spectrum.
    let cyclic = cyclic_spectrum(peptide)
    assert spectrum_score(spectrum, cyclic) == len(spectrum),
        "BA4J: every linear fragment should also be a cyclic one"
    assert len(cyclic) > len(spectrum), "BA4J: the wrapping pieces are extra"
}

BA4K — Compute the Score of a Linear Peptide Against a Spectrum

solvedbrowser + CLI Problem statement Open in the workbench Download .bl

8 against BA4F's 11 on identical input, because the linear spectrum has fewer masses to agree with.

# Rosalind: BA4K — Compute the Score of a Linear Peptide Against a Spectrum
# https://rosalind.info/problems/ba4k/
#
# Given: An amino acid string Peptide and a collection of integers Spectrum.
# Return: LinearScore(Peptide, Spectrum).

let peptide = "NQEL"
let observed = [0, 99, 113, 114, 128, 227, 257, 299, 355, 356, 370, 371, 484]

# The same comparison as BA4F against the linear spectrum, which scores lower
# because it has fewer masses to agree with — 8 against 11 on identical input.
#
# The reason to have both: sequencing grows a peptide one residue at a time, and
# a partial peptide is not yet a cycle. Scoring it cyclically would credit it with
# wrap-around fragments it does not have, and rank a bad prefix above a good one.
let score = spectrum_score(linear_spectrum(peptide), observed)

println("Result:   " + str(score))
println("Expected: 8")

fn test_ba4k_linear_scoring() {
    assert score == 8, "BA4K: got " + str(score)
    # Strictly lower than the cyclic score on the same input, because the linear
    # spectrum is a subset of the cyclic one.
    let cyclic = spectrum_score(cyclic_spectrum(peptide), observed)
    assert cyclic == 11, "BA4K: the cyclic score of the same peptide is 11"
    assert score < cyclic, "BA4K: linear scoring cannot exceed cyclic"
}

BA4L — Trim a Peptide Leaderboard

solvedbrowser + CLI Problem statement Open in the workbench Download .bl

Ties at the cutoff are kept, since cutting one arbitrarily can discard the right answer while keeping an equal rival. LAST and ALST are anagrams and still score differently — linear fragments are contiguous, so order matters.

# Rosalind: BA4L — Trim a Peptide Leaderboard
# https://rosalind.info/problems/ba4l/
#
# Given: A leaderboard of linear peptides, a spectrum, and an integer N.
# Return: The top N peptides, scored with LinearScore — plus every peptide tied
# with the Nth.

let leaderboard = ["LAST", "ALST", "TLLT", "TQAS"]
let observed = [0, 71, 87, 101, 113, 158, 184, 188, 259, 271, 372]
let keep = 2

# "Top N" with ties kept, not exactly N. Cutting a tie arbitrarily would make the
# search depend on the order peptides happened to be generated in, and can throw
# away the correct answer while retaining an equally-scoring rival. On this
# sample nothing actually ties at the cutoff, so the answer is the plain top two.
let scored = leaderboard |> map(|p| { peptide: p, score: spectrum_score(linear_spectrum(p), observed) })
let ranked = scored |> sort_by(|entry| 0 - entry.score)
let cutoff = ranked[keep - 1].score
let trimmed = ranked |> filter(|entry| entry.score >= cutoff) |> map(|entry| entry.peptide)

println("Scores:")
for entry in ranked { println("  " + entry.peptide + "  " + str(entry.score)) }
println("Result:   " + join(trimmed, " "))
println("Expected: LAST ALST")

fn test_ba4l_trim_leaderboard() {
    assert join(trimmed, " ") == "LAST ALST", "BA4L: got " + join(trimmed, " ")
    # LAST and ALST are anagrams and still score differently — 11 against 9 —
    # because linear subpeptides are *contiguous*. Rearranging the residues keeps
    # the total mass and the single-residue masses but changes every fragment in
    # between, which is exactly why a spectrum says something about order.
    assert sort(chars("LAST")) == sort(chars("ALST")), "BA4L: the two are anagrams"
    assert peptide_mass("LAST") == peptide_mass("ALST"), "BA4L: so they weigh the same"
    assert linear_spectrum("LAST") != linear_spectrum("ALST"),
        "BA4L: but their contiguous fragments differ"
    assert spectrum_score(linear_spectrum("LAST"), observed) == 11, "BA4L: LAST scores 11"
    assert spectrum_score(linear_spectrum("ALST"), observed) == 9, "BA4L: ALST scores 9"
    # Nothing below the cutoff survives.
    for entry in scored {
        if contains(trimmed, entry.peptide) == false {
            assert entry.score < cutoff, "BA4L: " + entry.peptide + " was dropped despite tying"
        }
    }
}

BA4M — Solve the Turnpike Problem

solvedbrowser + CLI Problem statement Open in the workbench Download .bl

Reading positions from pairwise distances, the same shape of problem as reading a peptide from fragment masses. Backtracking on the largest unplaced distance, which must reach one of the two ends — so each step has two choices rather than a search over all subsets.

# Rosalind: BA4M — Solve the Turnpike Problem
# https://rosalind.info/problems/ba4m/
#
# Given: All pairwise differences between points on a line.
# Return: A set of points A with those differences.

let differences = [-10, -8, -7, -6, -5, -4, -3, -3, -2, -2, 0, 0, 0, 0, 0,
                   2, 2, 3, 3, 4, 5, 6, 7, 8, 10]

# The same shape of problem as reading a peptide from its fragment masses, with
# positions on a line instead of residues — which is why it sits in this chapter.
#
# Backtracking on the largest unplaced distance. That distance must be between
# some point and one of the two ends, so there are only two choices at each step,
# and each is checked immediately against the remaining multiset. Placing points
# in arbitrary order instead would be a search over all subsets.
let positive = differences |> filter(|d| d > 0) |> sort()
let width = max(differences)

fn remove_all(pool, wanted) {
    let remaining = pool
    let ok = true
    for value in wanted {
        let found = range(0, len(remaining)) |> filter(|i| remaining[i] == value)
        if len(found) == 0 {
            ok = false
        } else {
            let at = found[0]
            remaining = range(0, len(remaining)) |> filter(|i| i != at) |> map(|i| remaining[i])
        }
    }
    { ok: ok, rest: remaining }
}

# Distances from a candidate point to everything already placed.
fn spans(point, placed) { placed |> map(|p| abs(point - p)) }

let solution = []
let stack = [{ placed: [0, width], pool: (remove_all(positive, [width])).rest }]
while len(stack) > 0 and len(solution) == 0 {
    let state = stack[len(stack) - 1]
    stack = slice(stack, 0, len(stack) - 1)

    if len(state.pool) == 0 {
        solution = sort(state.placed)
    } else {
        let largest = max(state.pool)
        # The largest remaining distance reaches either from the left end or to
        # the right end; nothing else could produce it.
        for candidate in [largest, width - largest] {
            if contains(state.placed, candidate) == false {
                let attempt = remove_all(state.pool, spans(candidate, state.placed))
                if attempt.ok {
                    stack = push(stack, {
                        placed: push(state.placed, candidate),
                        pool: attempt.rest,
                    })
                }
            }
        }
    }
}

println("Result:   " + (solution |> map(|p| str(p)) |> join(" ")))
println("Expected: 0 2 4 7 10")

fn test_ba4m_turnpike() {
    assert (solution |> map(|p| str(p)) |> join(" ")) == "0 2 4 7 10",
        "BA4M: got " + str(solution)
    # The real requirement: the answer's own pairwise differences are the input.
    let rebuilt = solution |> flat_map(|a| solution |> map(|b| a - b)) |> sort()
    assert rebuilt == sort(differences),
        "BA4M: the reconstructed differences do not match the input"
    assert len(rebuilt) == len(solution) * len(solution),
        "BA4M: n points give n^2 differences, including the n zeros"
}

BA5B — Find the Length of a Longest Path in a Manhattan-like Grid

solvedbrowser + CLI Problem statement Open in the workbench Download .bl

The grid is filled once in order and never revisited. Enumerating the paths would mean C(n+m, n) of them — 70 here, exponential in general. Longest path is NP-hard in general graphs; it is easy here only because the grid is acyclic.

# Rosalind: BA5B — Find the Length of a Longest Path in a Manhattan-like Grid
# https://rosalind.info/problems/ba5b/
#
# Given: Integers n and m, an n x (m+1) matrix Down, and an (n+1) x m matrix Right.
# Return: The length of a longest path from (0,0) to (n,m).

let n = 4
let m = 4
let down = [
    [1, 0, 2, 4, 3],
    [4, 6, 5, 2, 1],
    [4, 4, 5, 2, 1],
    [5, 6, 8, 5, 3],
]
let right = [
    [3, 2, 4, 0],
    [3, 2, 4, 2],
    [0, 7, 3, 3],
    [3, 3, 0, 2],
    [1, 3, 2, 2],
]

# The longest path to any corner is the better of arriving from above or from the
# left, and both were already computed — so the whole grid is filled once, in
# order, and never revisited. Searching the paths themselves would mean
# enumerating C(n+m, n) of them; here that is 70, but it grows exponentially.
#
# Longest path is NP-hard in general graphs. It is easy here only because the
# grid is acyclic and already comes in an order that respects its edges.
# The top row has no "above", so it fills from the left alone.
let top = [0]
for j in range(1, m + 1) { top = push(top, top[j - 1] + right[0][j - 1]) }

let best = [top]
for i in range(1, n + 1) {
    # Likewise the left column has only the edge above it.
    let row = [best[i - 1][0] + down[i - 1][0]]
    for j in range(1, m + 1) {
        let from_above = best[i - 1][j] + down[i - 1][j]
        let from_left = row[j - 1] + right[i][j - 1]
        row = push(row, max([from_above, from_left]))
    }
    best = push(best, row)
}

let answer = best[n][m]

println("Result:   " + str(answer))
println("Expected: 34")

fn test_ba5b_manhattan_tourist() {
    assert answer == 34, "BA5B: got " + str(answer)
    # The edges of the grid have only one way in, so those entries are plain
    # running totals — a useful check that the recurrence is indexed correctly.
    assert best[0][m] == sum(right[0]), "BA5B: the top row is the sum of its right edges"
    let left_column = range(0, n) |> map(|i| down[i][0]) |> sum()
    assert best[n][0] == left_column, "BA5B: the left column is the sum of its down edges"
    assert answer >= best[0][m] and answer >= best[n][0],
        "BA5B: the best path is at least as good as going round the edge"
}

BA5D — Find the Longest Path in a DAG

solvedbrowser + CLI Problem statement Open in the workbench Download .bl

Easy for one reason: the graph is acyclic, so its nodes can be ordered with every edge pointing forwards and each score is final when read. Unreachable nodes stay at negative infinity rather than 0, or a detour through one could outscore a real path.

# Rosalind: BA5D — Find the Longest Path in a DAG
# https://rosalind.info/problems/ba5d/
#
# Given: A source, a sink, and an edge-weighted directed acyclic graph.
# Return: The length of a longest path from source to sink, and the path.

let source = "0"
let sink = "4"
let arcs = [
    { from_node: "0", to_node: "1", weight: 7 },
    { from_node: "0", to_node: "2", weight: 4 },
    { from_node: "2", to_node: "3", weight: 2 },
    { from_node: "1", to_node: "4", weight: 1 },
    { from_node: "3", to_node: "4", weight: 3 },
]

# Longest path is NP-hard in general — in a graph with a positive cycle there is
# no longest path at all. It is easy here for exactly one reason: the graph is
# acyclic, so its vertices can be put in an order where every edge points forwards,
# and then each node's best score is final by the time it is read.
let incoming = {}
let vertices = sort(unique((arcs |> map(|e| e.from_node)) + (arcs |> map(|e| e.to_node))))
for node in vertices { incoming[node] = [] }
for edge in arcs { incoming[edge.to_node] = push(incoming[edge.to_node], edge) }

# Topological order, as in BA5N.
let pending = {}
for node in vertices { pending[node] = len(incoming[node]) }
let ready = vertices |> filter(|node| pending[node] == 0)
let order = []
while len(ready) > 0 {
    let node = ready[0]
    ready = slice(ready, 1, len(ready))
    order = push(order, node)
    for edge in arcs {
        if edge.from_node == node {
            pending[edge.to_node] = pending[edge.to_node] - 1
            if pending[edge.to_node] == 0 { ready = push(ready, edge.to_node) }
        }
    }
}

# Score every node in that order. Nodes unreachable from the source stay at
# "impossible" rather than 0 — otherwise a detour through one could look better
# than a real path.
let impossible = -1000000
let best = {}
let came_from = {}
for node in vertices { best[node] = impossible }
best[source] = 0

for node in order {
    for edge in incoming[node] {
        let candidate = best[edge.from_node] + edge.weight
        if best[edge.from_node] > impossible and candidate > best[node] {
            best[node] = candidate
            came_from[node] = edge.from_node
        }
    }
}

let path = [sink]
let walk = sink
while walk != source {
    walk = came_from[walk]
    path = push(path, walk)
}
path = reverse(path)

println("Result:   " + str(best[sink]))
println("          " + join(path, "->"))
println("Expected: 9")
println("          0->2->3->4")

fn test_ba5d_longest_path_in_a_dag() {
    assert best[sink] == 9, "BA5D: got " + str(best[sink])
    assert join(path, "->") == "0->2->3->4", "BA5D: got " + join(path, "->")
    # The path must start and end where asked, and its weights must add up to the
    # reported length — a length without a matching path is the usual bug here.
    assert path[0] == source and path[len(path) - 1] == sink, "BA5D: wrong endpoints"
    let walked = range(1, len(path)) |> map(|i| {
        let matching = arcs |> filter(|e| e.from_node == path[i - 1] and e.to_node == path[i])
        assert len(matching) > 0, "BA5D: " + path[i - 1] + "->" + path[i] + " is not an edge"
        matching[0].weight
    })
    assert sum(walked) == best[sink], "BA5D: the path's weights do not sum to its length"
    # The direct route 0->1->4 scores 8, so 9 really is better.
    assert best[sink] > 8, "BA5D: 0->1->4 scores 8 and must be beaten"
}

BA5K — Find a Middle Edge in an Alignment Graph in Linear Space

solvedbrowser + CLI Problem statement Open in the workbench Download .bl

A full alignment table costs O(nm) memory; one column costs O(n). Two linear-space sweeps meeting in the middle locate where the best alignment crosses it. Asserted against the full aligner: the middle node's total equals the alignment's own score.

# Rosalind: BA5K — Find a Middle Edge in an Alignment Graph in Linear Space
# https://rosalind.info/problems/ba5k/
#
# Given: Two amino acid strings.
# Return: A middle edge of their alignment graph, scored with BLOSUM62 and a
# linear indel penalty of 5.

let first_string = "PLEASANTLY"
let second_string = "MEASNLY"
let blosum = score_matrix("BLOSUM62")
let gap = 5

# The idea behind Hirschberg's algorithm. A full alignment table costs O(nm)
# memory, which for two chromosomes is not available. But one *column* of it
# costs O(n), and that is enough to find where the best alignment crosses the
# middle column — from which the problem splits in two and recurses.
#
# The score of the best path through a node is the best path into it plus the
# best path out of it, so two linear-space sweeps meeting in the middle locate
# the crossing without ever holding the table.
let middle = floor(len(second_string) / 2)

# One forward column: best score from (0,0) to each row of column `upto`.
fn forward_column(rows, columns, upto, matrix, indel) {
    let column = range(0, len(rows) + 1) |> map(|i| 0 - i * indel)
    for j in range(1, upto + 1) {
        let next = [0 - j * indel]
        for i in range(1, len(rows) + 1) {
            let diagonal = column[i - 1]
                + substitution_score(matrix, substr(rows, i - 1, 1), substr(columns, j - 1, 1))
            let down = next[i - 1] - indel
            let across = column[i] - indel
            next = push(next, max([diagonal, down, across]))
        }
        column = next
    }
    column
}

# The backward sweep is the forward one on both strings reversed, which is why
# only one direction has to be written.
let from_source = forward_column(first_string, second_string, middle, blosum, gap)
let to_sink_reversed = forward_column(reverse(first_string), reverse(second_string),
                                      len(second_string) - middle, blosum, gap)
let to_sink = reverse(to_sink_reversed)

let totals = range(0, len(first_string) + 1) |> map(|i| from_source[i] + to_sink[i])
let middle_row = argmax(totals)

# Which way the best path leaves the middle node. Three continuations are
# possible; the middle edge is whichever is best, and for this pair it is the
# diagonal one.
let beyond = forward_column(reverse(first_string), reverse(second_string),
                            len(second_string) - middle - 1, blosum, gap) |> reverse()

let at_bottom = middle_row == len(first_string)

let across = { row: middle_row, column: middle + 1, score: beyond[middle_row] - gap }
let down = {
    row: middle_row + 1,
    column: middle,
    score: if at_bottom then 0 - 1000000 else to_sink[middle_row + 1] - gap,
}
let diagonal = {
    row: middle_row + 1,
    column: middle + 1,
    score: if at_bottom then 0 - 1000000 else beyond[middle_row + 1]
        + substitution_score(blosum, substr(first_string, middle_row, 1), substr(second_string, middle, 1)),
}

let ranked = [diagonal, across, down] |> sort_by(|option| 0 - option.score)
let best_edge = ranked[0]

println("Result:   (" + str(middle_row) + ", " + str(middle) + ") ("
        + str(best_edge.row) + ", " + str(best_edge.column) + ")")
println("Expected: (4, 3) (5, 4)")

fn test_ba5k_middle_edge() {
    assert middle == 3, "BA5K: the middle column of a 7-long string is 3"
    assert middle_row == 4, "BA5K: got middle row " + str(middle_row)
    assert best_edge.row == 5 and best_edge.column == 4,
        "BA5K: got end (" + str(best_edge.row) + ", " + str(best_edge.column) + ")"
    # The middle node must lie on a best alignment, so the best path through it
    # scores exactly what the full alignment scores. That is the property the
    # whole linear-space method depends on.
    let full = align(protein(first_string), protein(second_string), "global", 0, 0, 0 - gap, 0, "blosum62")
    assert totals[middle_row] == full.score,
        "BA5K: the middle node scores " + str(totals[middle_row])
            + " but the alignment scores " + str(full.score)
    # And no row beats it.
    for i in range(0, len(totals)) {
        assert totals[i] <= totals[middle_row], "BA5K: row " + str(i) + " scores higher"
    }
}

BA5L — Align Two Strings Using Linear Space

solvedbrowser + CLI Problem statement Open in the workbench Download .bl

Hirschberg's algorithm on BA5K's middle edge. Each half is re-swept, but the halves shrink geometrically so the total stays O(nm) while memory drops from a table to a column — the trade that makes whole-genome alignment possible. Reproduces the published alignment exactly.

# Rosalind: BA5L — Align Two Strings Using Linear Space
# https://rosalind.info/problems/ba5l/
#
# Given: Two amino acid strings.
# Return: Their maximum global alignment score, and an alignment achieving it,
# using BLOSUM62 and a linear indel penalty of 5.

let first_string = "PLEASANTLY"
let second_string = "MEANLY"
let blosum = score_matrix("BLOSUM62")
let gap = 5

# Hirschberg's algorithm, built on BA5K's middle edge. The full alignment table
# needs O(nm) memory — for two chromosomes that is terabytes — but a single
# column needs only O(n). Finding where the best alignment crosses the middle
# column costs two linear-space sweeps, and then the problem splits into two
# halves that are solved the same way.
#
# The work roughly doubles (each half is re-swept) but the total stays O(nm),
# because the halves shrink geometrically: nm/2 + nm/4 + ... < nm. Memory drops
# from a table to a column, which is the trade that makes whole-genome alignment
# possible at all.
fn column_scores(rows, columns, matrix, indel) {
    let column = range(0, len(rows) + 1) |> map(|i| 0 - i * indel)
    for j in range(1, len(columns) + 1) {
        let next = [0 - j * indel]
        for i in range(1, len(rows) + 1) {
            let diagonal = column[i - 1]
                + substitution_score(matrix, substr(rows, i - 1, 1), substr(columns, j - 1, 1))
            let down = next[i - 1] - indel
            let across = column[i] - indel
            next = push(next, max([diagonal, down, across]))
        }
        column = next
    }
    column
}

# Returns the two aligned strings for the given pair.
fn hirschberg(rows, columns, matrix, indel) {
    if len(columns) == 0 {
        return [rows, range(0, len(rows)) |> map(|_| "-") |> join("")]
    }
    if len(rows) == 0 {
        return [range(0, len(columns)) |> map(|_| "-") |> join(""), columns]
    }
    if len(rows) == 1 or len(columns) == 1 {
        # Small enough that a full table is a column; fall back to the ordinary
        # alignment rather than recursing further.
        let small = align(protein(rows), protein(columns), "global", 0, 0, 0 - indel, 0, "blosum62")
        return [str(small.aligned_a), str(small.aligned_b)]
    }

    let middle = floor(len(columns) / 2)
    let left = column_scores(rows, substr(columns, 0, middle), matrix, indel)
    let right = column_scores(reverse(rows), reverse(substr(columns, middle, len(columns) - middle)),
                              matrix, indel) |> reverse()
    let split_at = argmax(range(0, len(rows) + 1) |> map(|i| left[i] + right[i]))

    let top = hirschberg(substr(rows, 0, split_at), substr(columns, 0, middle), matrix, indel)
    let bottom = hirschberg(substr(rows, split_at, len(rows) - split_at),
                            substr(columns, middle, len(columns) - middle), matrix, indel)
    [top[0] + bottom[0], top[1] + bottom[1]]
}

let aligned = hirschberg(first_string, second_string, blosum, gap)

fn alignment_score(a, b, matrix, indel) {
    range(0, len(a)) |> map(|i| {
        let x = substr(a, i, 1)
        let y = substr(b, i, 1)
        if x == "-" or y == "-" then 0 - indel else substitution_score(matrix, x, y)
    }) |> sum()
}

let score = alignment_score(aligned[0], aligned[1], blosum, gap)

println("Result:   " + str(int(score)))
println("          " + aligned[0])
println("          " + aligned[1])
println("Expected: 8")
println("          PLEASANTLY")
println("          -MEA--N-LY")

fn test_ba5l_linear_space_alignment() {
    assert score == 8, "BA5L: scored " + str(score)
    # Any alignment achieving the optimum is accepted, so the checks are
    # structural: both rows the same length, gaps never opposite gaps, and each
    # row reduces to its original string.
    assert len(aligned[0]) == len(aligned[1]), "BA5L: the rows must line up"
    let both_gaps = range(0, len(aligned[0]))
        |> count_if(|i| substr(aligned[0], i, 1) == "-" and substr(aligned[1], i, 1) == "-")
    assert both_gaps == 0, "BA5L: a column of two gaps is not an alignment"
    assert replace(aligned[0], "-", "") == first_string, "BA5L: row one is not the first string"
    assert replace(aligned[1], "-", "") == second_string, "BA5L: row two is not the second string"
    # And it matches what the quadratic-space aligner computes.
    let reference = align(protein(first_string), protein(second_string),
                          "global", 0, 0, 0 - gap, 0, "blosum62")
    assert score == reference.score,
        "BA5L: linear space scored " + str(score) + " but the table scored " + str(reference.score)
}

BA5M — Find a Highest-Scoring Multiple Sequence Alignment

solvedbrowser + CLI Problem statement Open in the workbench Download .bl

Three sequences need a cube, and each cell has seven predecessors rather than three. The cost is O(n^k), which is why exact multiple alignment stops being possible at a handful of sequences and real tools use heuristics. Returns a different optimal alignment from the published one; the assertion recounts the agreeing columns.

# Rosalind: BA5M — Find a Highest-Scoring Multiple Sequence Alignment
# https://rosalind.info/problems/ba5m/
#
# Given: Three DNA strings.
# Return: The maximum score of a three-way alignment — one point per column where
# all three symbols agree — and an alignment achieving it.

let one = "ATATCCG"
let two = "TCCGA"
let three = "ATGTACTG"

# Two strings need a table; three need a cube, and each cell has seven
# predecessors rather than three — every non-empty choice of which sequences
# advance. That is the point this problem makes: the cost is O(n^k) in the number
# of sequences, so aligning ten sequences exactly is out of reach and real
# multiple alignment is done by heuristics instead.
let moves = [
    [1, 1, 1], [1, 1, 0], [1, 0, 1], [0, 1, 1], [1, 0, 0], [0, 1, 0], [0, 0, 1],
]

let best = {}
let came_from = {}
fn key(i, j, k) { str(i) + "," + str(j) + "," + str(k) }

best[key(0, 0, 0)] = 0
for i in range(0, len(one) + 1) {
    for j in range(0, len(two) + 1) {
        for k in range(0, len(three) + 1) {
            if i + j + k > 0 {
                let here = key(i, j, k)
                best[here] = 0 - 1000000
                for move in moves {
                    let pi = i - move[0]
                    let pj = j - move[1]
                    let pk = k - move[2]
                    if pi >= 0 and pj >= 0 and pk >= 0 {
                        # A column scores only when all three advance onto the
                        # same symbol; every other move scores nothing.
                        let matched = move[0] == 1 and move[1] == 1 and move[2] == 1
                            and substr(one, pi, 1) == substr(two, pj, 1)
                            and substr(two, pj, 1) == substr(three, pk, 1)
                        let candidate = best[key(pi, pj, pk)] + (if matched then 1 else 0)
                        if candidate > best[here] {
                            best[here] = candidate
                            came_from[here] = move
                        }
                    }
                }
            }
        }
    }
}

let score = best[key(len(one), len(two), len(three))]

let rows = ["", "", ""]
let at = [len(one), len(two), len(three)]
while at[0] + at[1] + at[2] > 0 {
    let move = came_from[key(at[0], at[1], at[2])]
    let sources = [one, two, three]
    for s in range(0, 3) {
        if move[s] == 1 {
            rows[s] = substr(sources[s], at[s] - 1, 1) + rows[s]
            at[s] = at[s] - 1
        } else {
            rows[s] = "-" + rows[s]
        }
    }
}

println("Result:   " + str(score))
for line in rows { println("          " + line) }
println("Expected: 3")
println("          ATATCC-G-")
println("          ---TCC-GA")
println("          ATGTACTG-")

fn test_ba5m_multiple_alignment() {
    assert score == 3, "BA5M: scored " + str(score)
    # Any alignment reaching 3 is accepted, so the checks are structural.
    assert len(rows[0]) == len(rows[1]) and len(rows[1]) == len(rows[2]),
        "BA5M: all three rows must be the same length"
    assert replace(rows[0], "-", "") == one, "BA5M: line 1 is not the first string"
    assert replace(rows[1], "-", "") == two, "BA5M: line 2 is not the second string"
    assert replace(rows[2], "-", "") == three, "BA5M: line 3 is not the third string"
    # And the alignment shown really scores what was claimed.
    let agreeing = range(0, len(rows[0])) |> count_if(|i| {
        let a = substr(rows[0], i, 1)
        a != "-" and a == substr(rows[1], i, 1) and a == substr(rows[2], i, 1)
    })
    assert agreeing == score, "BA5M: " + str(agreeing) + " columns agree, not " + str(score)
}

BA5N — Find a Topological Ordering of a DAG

solvedbrowser + CLI Problem statement Open in the workbench Download .bl

Kahn's algorithm with a FIFO queue. This is what BA5B and BA5D stand on: a longest path can be found in one sweep only if each node is reached after everything leading into it. Several orderings are valid, so the assertion checks every edge points forwards.

# Rosalind: BA5N — Find a Topological Ordering of a DAG
# https://rosalind.info/problems/ba5n/
#
# Given: The adjacency list of a directed acyclic graph.
# Return: A topological ordering of its vertices.

let adjacency = {
    "1": ["2"],
    "2": ["3"],
    "4": ["2"],
    "5": ["3"],
}

# An order in which every edge points forwards. This is what makes BA5B and BA5D
# possible: a longest path can be found in one sweep only if each node is reached
# after everything that leads into it.
#
# Kahn's algorithm: repeatedly take a node nothing points at, remove it, and see
# what that frees. The initial set is sorted so the answer does not depend on
# hash iteration order; freed vertices then join the back of the queue, which is
# what makes this first-in-first-out rather than a re-sort each round.
#
# Any ordering with every edge pointing forwards is correct — several exist here,
# and the assertion checks that property rather than only the printed string.
let vertices = sort(unique(keys(adjacency) + (keys(adjacency) |> flat_map(|k| adjacency[k]))))

let incoming = {}
for node in vertices { incoming[node] = 0 }
for node in keys(adjacency) {
    for target in adjacency[node] { incoming[target] = incoming[target] + 1 }
}

let ready = vertices |> filter(|node| incoming[node] == 0) |> sort()
let ordering = []
while len(ready) > 0 {
    let node = ready[0]
    ready = slice(ready, 1, len(ready))
    ordering = push(ordering, node)
    if contains(keys(adjacency), node) {
        for target in adjacency[node] {
            incoming[target] = incoming[target] - 1
            if incoming[target] == 0 { ready = push(ready, target) }
        }
    }
}

println("Result:   " + join(ordering, ", "))
println("Expected: 1, 4, 5, 2, 3")

fn test_ba5n_topological_ordering() {
    assert join(ordering, ", ") == "1, 4, 5, 2, 3", "BA5N: got " + join(ordering, ", ")
    # Every node appears exactly once...
    assert sort(ordering) == vertices, "BA5N: the ordering must list every node once"
    # ...and every edge points forwards, which is the whole definition.
    let position = {}
    for i in range(0, len(ordering)) { position[ordering[i]] = i }
    for node in keys(adjacency) {
        for target in adjacency[node] {
            assert position[node] < position[target],
                "BA5N: " + node + " -> " + target + " points backwards"
        }
    }
}

BA8D — Implement the Soft k-Means Clustering Algorithm

solvedbrowser + CLI Problem statement Open in the workbench Download .bl

Where BA8C forces every point to pick one cluster, here a point midway between two centers pulls on both. Beta sets how decisive that sharing is: large beta reproduces Lloyd, small beta drags every center towards the overall mean.

# Rosalind: BA8D — Implement the Soft k-Means Clustering Algorithm
# https://rosalind.info/problems/ba8d/
#
# Given: Integers k and m, a stiffness parameter beta, and n points in m
# dimensions.
# Return: The k centers after 100 rounds of soft k-means.

let k = 2
let beta = 2.7
let steps = 100
let points = [
    [1.3, 1.1], [1.3, 0.2], [0.6, 2.8], [3.0, 3.2], [1.2, 0.7],
    [1.4, 1.6], [1.2, 1.0], [1.2, 1.1], [0.6, 1.5], [1.8, 2.6],
    [1.2, 1.3], [1.2, 1.0], [0.0, 1.9],
]

# BA8C's Lloyd algorithm makes every point choose one cluster. Here each point is
# shared out among all of them, weighted by e^(-beta * distance) — so a point
# midway between two centers pulls on both instead of being forced to pick, and a
# center is the weighted mean of everything rather than of its own members.
#
# beta is how decisive that sharing is. Large beta approaches hard assignment and
# reproduces Lloyd; small beta pulls every center towards the overall mean.
fn distance(a, b) {
    sqrt(range(0, len(a)) |> map(|i| (a[i] - b[i]) * (a[i] - b[i])) |> sum())
}

let centers = range(0, k) |> map(|i| points[i])

for _ in range(0, steps) {
    # E-step: how much each center is responsible for each point.
    let responsibility = centers |> map(|center|
        points |> map(|point| exp(0 - beta * distance(point, center))))

    let totals = range(0, len(points))
        |> map(|j| range(0, k) |> map(|i| responsibility[i][j]) |> sum())

    # M-step: each center becomes the weighted mean of every point.
    centers = range(0, k) |> map(|i| {
        let weights = range(0, len(points)) |> map(|j| responsibility[i][j] / totals[j])
        let weight_sum = sum(weights)
        range(0, len(points[0])) |> map(|d|
            (range(0, len(points)) |> map(|j| weights[j] * points[j][d]) |> sum()) / weight_sum)
    })
}

println("Result:")
for center in centers { println("  " + (center |> map(|c| str(round(c, 3))) |> join(" "))) }
println("Expected:")
println("  1.662 2.623")
println("  1.075 1.148")

fn test_ba8d_soft_k_means() {
    let expected = [[1.662, 2.623], [1.075, 1.148]]
    for i in range(0, k) {
        for d in range(0, 2) {
            assert abs(centers[i][d] - expected[i][d]) < 5e-4,
                "BA8D: center " + str(i) + " coordinate " + str(d)
                    + " is " + str(round(centers[i][d], 3))
                    + ", expected " + str(expected[i][d])
        }
    }
    # Soft assignment means every point contributes to every center, so no center
    # can sit outside the bounding box of the data.
    for center in centers {
        for d in range(0, 2) {
            let column = points |> map(|p| p[d])
            assert center[d] >= min(column) and center[d] <= max(column),
                "BA8D: a weighted mean cannot fall outside the data"
        }
    }
}

BA8E — Implement Hierarchical Clustering

solvedbrowser + CLI Problem statement Open in the workbench Download .bl

Needs no k. Produces a nested family of partitions rather than one — which is what a phylogenetic tree is. Average linkage is specified and it matters: single linkage chains elongated clusters, complete linkage insists on compactness.

# Rosalind: BA8E — Implement Hierarchical Clustering
# https://rosalind.info/problems/ba8e/
#
# Given: An integer n and an n x n distance matrix.
# Return: The clusters formed, in the order they are merged.

let n = 7
let distances = [
    [0.00, 0.74, 0.85, 0.54, 0.83, 0.92, 0.89],
    [0.74, 0.00, 1.59, 1.35, 1.20, 1.48, 1.55],
    [0.85, 1.59, 0.00, 0.63, 1.13, 0.69, 0.73],
    [0.54, 1.35, 0.63, 0.00, 0.66, 0.43, 0.88],
    [0.83, 1.20, 1.13, 0.66, 0.00, 0.72, 0.55],
    [0.92, 1.48, 0.69, 0.43, 0.72, 0.00, 0.80],
    [0.89, 1.55, 0.73, 0.88, 0.55, 0.80, 0.00],
]

# Unlike k-means, nothing has to be told how many clusters there are. Every point
# starts alone, the two closest merge, and the process is repeated — producing not
# one partition but a whole nested family of them, which is what a phylogenetic
# tree is.
#
# "Closest" here is average linkage: the mean distance between all pairs across
# the two clusters. That choice matters — single linkage would chain elongated
# clusters together, complete linkage would insist on compactness — and it is the
# one this problem specifies.
let clusters = range(0, n) |> map(|i| [i])
let merged_order = []

fn average_distance(left, right, matrix) {
    let total = left |> flat_map(|a| right |> map(|b| matrix[a][b])) |> sum()
    total / (len(left) * len(right))
}

while len(clusters) > 1 {
    let best_i = 0
    let best_j = 1
    let best = average_distance(clusters[0], clusters[1], distances)
    for i in range(0, len(clusters)) {
        for j in range(i + 1, len(clusters)) {
            let candidate = average_distance(clusters[i], clusters[j], distances)
            if candidate < best {
                best = candidate
                best_i = i
                best_j = j
            }
        }
    }

    let joined = clusters[best_i] + clusters[best_j]
    merged_order = push(merged_order, joined)
    clusters = range(0, len(clusters))
        |> filter(|i| i != best_i and i != best_j)
        |> map(|i| clusters[i])
    clusters = push(clusters, joined)
}

# Reported one-based, which is how the sample is written.
let reported = merged_order |> map(|cluster| cluster |> map(|i| str(i + 1)) |> join(" "))

println("Result:")
for line in reported { println("  " + line) }
println("Expected:")
println("  4 6 / 5 7 / 3 4 6 / 1 2 / 5 7 3 4 6 / 1 2 5 7 3 4 6")

fn test_ba8e_hierarchical_clustering() {
    assert len(merged_order) == n - 1, "BA8E: n points take n-1 merges"
    # The first merge must be the closest pair in the matrix, which is 4 and 6 at
    # 0.43 — checked against the matrix rather than against the expected output.
    assert reported[0] == "4 6", "BA8E: first merge was " + reported[0]
    assert distances[3][5] == 0.43, "BA8E: 4 and 6 are 0.43 apart"
    let closest = range(0, n) |> flat_map(|i| range(i + 1, n) |> map(|j| distances[i][j])) |> min()
    assert closest == 0.43, "BA8E: and nothing is closer"
    # The last merge gathers everything.
    assert len(merged_order[n - 2]) == n, "BA8E: the final cluster holds every point"
    assert sort(merged_order[n - 2]) == range(0, n), "BA8E: and holds each point once"
    assert join(reported, " / ") == "4 6 / 5 7 / 3 4 6 / 1 2 / 5 7 3 4 6 / 1 2 5 7 3 4 6",
        "BA8E: got " + join(reported, " / ")
}

BA7A — Compute Distances Between Leaves

solvedbrowser + CLI Problem statement Open in the workbench Download .bl

In a tree there is exactly one path between any two nodes, so there is nothing to optimise — no Dijkstra, no relaxation. That uniqueness is also what lets BA7C invert the distances to recover the tree.

# Rosalind: BA7A — Compute Distances Between Leaves
# https://rosalind.info/problems/ba7a/
#
# Given: An integer n and the adjacency list of a weighted tree with n leaves.
# Return: The n x n matrix of path lengths between leaves.

let leaf_count = 4
let tree = {
    "0": [{ to_node: "4", weight: 11 }],
    "1": [{ to_node: "4", weight: 2 }],
    "2": [{ to_node: "5", weight: 6 }],
    "3": [{ to_node: "5", weight: 7 }],
    "4": [{ to_node: "0", weight: 11 }, { to_node: "1", weight: 2 }, { to_node: "5", weight: 4 }],
    "5": [{ to_node: "4", weight: 4 }, { to_node: "3", weight: 7 }, { to_node: "2", weight: 6 }],
}

# In a tree there is exactly one path between any two nodes, so there is nothing
# to optimise — no Dijkstra, no relaxation. Walking outwards from each leaf and
# recording what it costs to arrive is enough, and each node is reached once.
# That uniqueness is what a tree buys, and it is also why these distances can be
# inverted to recover the tree in BA7C.
fn distances_from(start, graph) {
    let seen = { }
    seen[start] = 0
    let frontier = [start]
    while len(frontier) > 0 {
        let node = frontier[0]
        frontier = slice(frontier, 1, len(frontier))
        for edge in graph[node] {
            if contains(keys(seen), edge.to_node) == false {
                seen[edge.to_node] = seen[node] + edge.weight
                frontier = push(frontier, edge.to_node)
            }
        }
    }
    seen
}

let leaf_distances = range(0, leaf_count) |> map(|i| {
    let reach = distances_from(str(i), tree)
    range(0, leaf_count) |> map(|j| reach[str(j)])
})

println("Result:")
for line in leaf_distances { println("  " + (line |> map(|d| str(d)) |> join("\t"))) }
println("Expected:")
println("  0 13 21 22 / 13 0 12 13 / 21 12 0 13 / 22 13 13 0")

fn test_ba7a_distances_between_leaves() {
    let expected = [[0, 13, 21, 22], [13, 0, 12, 13], [21, 12, 0, 13], [22, 13, 13, 0]]
    assert leaf_distances == expected, "BA7A: got " + str(leaf_distances)
    # A distance matrix from a tree is symmetric, zero on the diagonal, and obeys
    # the triangle inequality — properties BA7C relies on to rebuild the tree.
    for i in range(0, leaf_count) {
        assert leaf_distances[i][i] == 0, "BA7A: a leaf is no distance from itself"
        for j in range(0, leaf_count) {
            assert leaf_distances[i][j] == leaf_distances[j][i], "BA7A: the leaf_distances must be symmetric"
            for k in range(0, leaf_count) {
                assert leaf_distances[i][j] <= leaf_distances[i][k] + leaf_distances[k][j],
                    "BA7A: the triangle inequality fails at "
                        + str(i) + "," + str(j) + "," + str(k)
            }
        }
    }
}

BA7B — Compute Limb Length

solvedbrowser + CLI Problem statement Open in the workbench Download .bl

The minimum over pairs picks the two leaves whose paths diverge immediately, leaving the limb alone. This is what makes BA7C possible: knowing the limb, it can be subtracted off and the leaf removed.

# Rosalind: BA7B — Compute Limb Length
# https://rosalind.info/problems/ba7b/
#
# Given: An integer n, a leaf j, and an additive n x n distance matrix.
# Return: The length of the limb connecting leaf j to the rest of the tree.

let leaf_count = 4
let target = 1
let distances = [
    [0, 13, 21, 22],
    [13, 0, 12, 13],
    [21, 12, 0, 13],
    [22, 13, 13, 0],
]

# For any two other leaves i and k, the paths from j to each of them share the
# limb and then diverge, so (D[i][j] + D[j][k] - D[i][k]) / 2 is the limb plus
# however much further the two paths run together. Taking the minimum over all
# pairs picks the pair that diverges immediately, leaving the limb alone.
#
# This is what makes BA7C possible: knowing the limb length, it can be subtracted
# off and the leaf removed, shrinking the problem by one.
let candidates = range(0, leaf_count)
    |> filter(|i| i != target)
    |> flat_map(|i| range(0, leaf_count)
        |> filter(|k| k != target and k != i)
        |> map(|k| (distances[i][target] + distances[target][k] - distances[i][k]) / 2))

let limb = min(candidates)

println("Result:   " + str(limb))
println("Expected: 2")

fn test_ba7b_limb_length() {
    assert limb == 2, "BA7B: got " + str(limb)
    # The limb can never be longer than half of any distance from j, and never
    # negative in an additive matrix.
    assert limb >= 0, "BA7B: a limb cannot have negative length"
    for i in range(0, leaf_count) {
        if i != target {
            assert limb <= distances[target][i],
                "BA7B: the limb cannot exceed the distance to leaf " + str(i)
        }
    }
    # Leaf 0's limb in the same tree is 11, which BA7A's tree confirms.
    let for_leaf_zero = range(1, leaf_count)
        |> flat_map(|i| range(1, leaf_count)
            |> filter(|k| k != i)
            |> map(|k| (distances[i][0] + distances[0][k] - distances[i][k]) / 2))
    assert min(for_leaf_zero) == 11, "BA7B: leaf 0 hangs off an 11-long limb"
}

BA7C — Implement AdditivePhylogeny

solvedbrowser + CLI Problem statement Open in the workbench Download .bl

The exact inverse of BA7A. Exact only because the matrix is additive. Asserted by rebuilding every pairwise distance from the tree rather than by matching one printed layout, since internal node numbering is not unique.

# Rosalind: BA7C — Implement AdditivePhylogeny
# https://rosalind.info/problems/ba7c/
#
# Given: An integer n and an additive n x n distance matrix.
# Return: The weighted adjacency list of the simple tree fitting the matrix.

let leaf_count = 4
let distances = [
    [0, 13, 21, 22],
    [13, 0, 12, 13],
    [21, 12, 0, 13],
    [22, 13, 13, 0],
]

# The exact inverse of BA7A: given the distances, recover the tree. It works by
# shrinking the problem — compute a leaf's limb length as in BA7B, subtract it
# from that leaf's row and column, and the leaf now sits at distance zero from
# its attachment point, so it can be removed. Solve the smaller matrix, then hang
# the leaf back on at the right place.
#
# This is exact only because the matrix is additive: some pair of remaining
# leaves must have the attachment point exactly on the path between them, which
# is what says where to graft.
let adjacency = {}
let next_id = leaf_count

fn connect(graph, a, b, weight) {
    let entry = { to_node: b, weight: weight }
    if contains(keys(graph), a) {
        graph[a] = push(graph[a], entry)
    } else {
        graph[a] = [entry]
    }
    graph
}

fn limb_length_of(matrix, leaf, size) {
    range(0, size)
        |> filter(|i| i != leaf)
        |> flat_map(|i| range(0, size)
            |> filter(|k| k != leaf and k != i)
            |> map(|k| (matrix[i][leaf] + matrix[leaf][k] - matrix[i][k]) / 2))
        |> min()
}

# Distance along the tree between two nodes, used to find where to graft.
fn tree_distance(graph, start, finish) {
    let seen = {}
    seen[start] = 0
    let frontier = [start]
    while len(frontier) > 0 {
        let node = frontier[0]
        frontier = slice(frontier, 1, len(frontier))
        if contains(keys(graph), node) {
            for edge in graph[node] {
                if contains(keys(seen), edge.to_node) == false {
                    seen[edge.to_node] = seen[node] + edge.weight
                    frontier = push(frontier, edge.to_node)
                }
            }
        }
    }
    seen[finish]
}

# The path of nodes between two leaves, so the graft point can be located on it.
fn path_between(graph, start, finish) {
    let came_from = {}
    let seen = { }
    seen[start] = true
    let frontier = [start]
    while len(frontier) > 0 {
        let node = frontier[0]
        frontier = slice(frontier, 1, len(frontier))
        if contains(keys(graph), node) {
            for edge in graph[node] {
                if contains(keys(seen), edge.to_node) == false {
                    seen[edge.to_node] = true
                    came_from[edge.to_node] = node
                    frontier = push(frontier, edge.to_node)
                }
            }
        }
    }
    let walk = [finish]
    let at = finish
    while at != start {
        at = came_from[at]
        walk = push(walk, at)
    }
    reverse(walk)
}

fn build(matrix, size, graph, fresh) {
    if size == 2 {
        let g = connect(connect(graph, "0", "1", matrix[0][1]), "1", "0", matrix[0][1])
        return { graph: g, next: fresh }
    }

    let leaf = size - 1
    let limb = limb_length_of(matrix, leaf, size)
    # Trim the limb off, so the leaf sits exactly on its attachment point. Built
    # as a new matrix rather than edited in place — `m[i][j] = x` is not
    # something the language offers, only `m[i] = row`.
    let trimmed = range(0, size) |> map(|r| range(0, size) |> map(|c| {
        let touches_leaf = (r == leaf and c != leaf) or (c == leaf and r != leaf)
        if touches_leaf then matrix[r][c] - limb else matrix[r][c]
    }))

    # Two leaves whose path passes through the attachment point.
    let found = { i: 0, k: 0, at: 0 }
    for i in range(0, size - 1) {
        for k in range(0, size - 1) {
            if i != k and trimmed[i][k] == trimmed[i][leaf] + trimmed[leaf][k] {
                found = { i: i, k: k, at: trimmed[i][leaf] }
            }
        }
    }

    let smaller = build(matrix, size - 1, graph, fresh)
    let g = smaller.graph
    let id = smaller.next

    # Walk from i towards k until the attachment distance is reached; the graft
    # point is either an existing node or a new one splitting an edge.
    let walk = path_between(g, str(found.i), str(found.k))
    let travelled = 0
    let attach = walk[0]
    let previous = walk[0]
    for step in range(1, len(walk)) {
        if travelled < found.at {
            previous = walk[step - 1]
            travelled = travelled + tree_distance(g, walk[step - 1], walk[step])
            attach = walk[step]
        }
    }

    if travelled == found.at {
        # Lands exactly on an existing node.
        g = connect(connect(g, attach, str(leaf), limb), str(leaf), attach, limb)
        return { graph: g, next: id }
    }

    # Otherwise split the edge previous->attach with a new internal node.
    let overshoot = travelled - found.at
    let edge_weight = tree_distance(g, previous, attach)
    let new_node = str(id)
    g[previous] = g[previous] |> filter(|e| e.to_node != attach)
    g[attach] = g[attach] |> filter(|e| e.to_node != previous)
    g = connect(connect(g, previous, new_node, edge_weight - overshoot),
                new_node, previous, edge_weight - overshoot)
    g = connect(connect(g, new_node, attach, overshoot), attach, new_node, overshoot)
    g = connect(connect(g, new_node, str(leaf), limb), str(leaf), new_node, limb)
    { graph: g, next: id + 1 }
}

let built = build(distances, leaf_count, adjacency, leaf_count)
let tree = built.graph

let listed = sort(keys(tree)) |> flat_map(|node|
    tree[node] |> map(|edge| node + "->" + edge.to_node + ":" + str(edge.weight)))

println("Result:")
for line in listed { println("  " + line) }
println("Expected: 0->4:11, 1->4:2, 2->5:6, 3->5:7, 4->5:4")

fn test_ba7c_additive_phylogeny() {
    # The real requirement: the tree reproduces the matrix it was built from.
    # That is checkable directly, and stronger than matching one printed layout,
    # since the internal node numbering is not unique.
    for i in range(0, leaf_count) {
        for j in range(0, leaf_count) {
            assert tree_distance(tree, str(i), str(j)) == distances[i][j],
                "BA7C: leaves " + str(i) + " and " + str(j) + " are "
                    + str(tree_distance(tree, str(i), str(j)))
                    + " apart in the tree but " + str(distances[i][j]) + " in the matrix"
        }
    }
    # A tree with n leaves and only internal nodes of degree 3 has n - 2 of them.
    let internal = keys(tree) |> filter(|node| int(node) >= leaf_count)
    assert len(internal) == leaf_count - 2,
        "BA7C: expected " + str(leaf_count - 2) + " internal nodes, got " + str(len(internal))
}

BA7D — Implement UPGMA

solvedbrowser + CLI Problem statement Open in the workbench Download .bl

Hierarchical clustering with heights, so every leaf ends the same distance from the root — a molecular clock made concrete. The assertion checks that ultrametric property directly. Often wrong in practice, which is what BA7E exists to avoid.

# Rosalind: BA7D — Implement UPGMA
# https://rosalind.info/problems/ba7d/
#
# Given: An integer n and an n x n distance matrix.
# Return: The adjacency list of the ultrametric tree UPGMA builds.

let leaf_count = 4
let distances = [
    [0, 20, 17, 11],
    [20, 0, 20, 13],
    [17, 20, 0, 10],
    [11, 13, 10, 0],
]

# Hierarchical clustering with heights attached. Each new node is placed at half
# the distance between the two clusters it joins, so every leaf ends up the same
# distance from the root — that is what "ultrametric" means, and it amounts to
# assuming a molecular clock: every lineage evolving at the same rate.
#
# That assumption is often wrong, which is what BA7E's neighbour joining exists to
# avoid. UPGMA is here to show what the simpler assumption costs.
let clusters = range(0, leaf_count) |> map(|i| [i])
let sizes = range(0, leaf_count) |> map(|_| 1)
let ages = range(0, leaf_count) |> map(|_| 0.0)
let live = range(0, leaf_count)
let separation = distances |> map(|line| line |> map(|d| d * 1.0))
let next_id = leaf_count
let adjacency = {}

fn connect(graph, a, b, weight) {
    let entry = { to_node: str(b), weight: round(weight, 3) }
    if contains(keys(graph), str(a)) {
        graph[str(a)] = push(graph[str(a)], entry)
    } else {
        graph[str(a)] = [entry]
    }
    graph
}

while len(live) > 1 {
    # The closest pair of clusters, by average distance.
    let best_a = live[0]
    let best_b = live[1]
    let best = separation[best_a][best_b]
    for a in live {
        for b in live {
            if a < b and separation[a][b] < best {
                best = separation[a][b]
                best_a = a
                best_b = b
            }
        }
    }

    # The new node sits half the distance up, and each child's limb is whatever
    # is left after its own age.
    let age = best / 2
    adjacency = connect(adjacency, next_id, best_a, age - ages[best_a])
    adjacency = connect(adjacency, best_a, next_id, age - ages[best_a])
    adjacency = connect(adjacency, next_id, best_b, age - ages[best_b])
    adjacency = connect(adjacency, best_b, next_id, age - ages[best_b])

    # Average distance from the merged cluster to everything else, weighted by
    # how many leaves each side holds.
    let merged_size = sizes[best_a] + sizes[best_b]
    let row = range(0, next_id + 1) |> map(|_| 0.0)
    for other in live {
        if other != best_a and other != best_b {
            row[other] = (separation[best_a][other] * sizes[best_a]
                        + separation[best_b][other] * sizes[best_b]) / merged_size
        }
    }
    separation = push(separation, row)
    for other in live {
        if other != best_a and other != best_b {
            separation[other] = push(separation[other], row[other])
        }
    }

    sizes = push(sizes, merged_size)
    ages = push(ages, age)
    live = (live |> filter(|node| node != best_a and node != best_b)) + [next_id]
    next_id = next_id + 1
}

let listed = sort(keys(adjacency)) |> flat_map(|node|
    adjacency[node] |> map(|edge| node + "->" + edge.to_node + ":" + str(round(edge.weight, 3))))

println("Result:")
for line in listed { println("  " + line) }
println("Expected: 0->5:7.000, 1->6:8.833, 2->4:5.000, 3->4:5.000, 4->5:2.000, 5->6:1.833")

fn test_ba7d_upgma() {
    # Every edge, checked by name so ordering does not matter.
    # Rosalind prints these to three decimals; BioLang prints the shortest exact
    # form, so 7.000 shows as 7.0. The values are the same.
    let want = ["0->5:7.0", "5->0:7.0", "1->6:8.833", "6->1:8.833", "2->4:5.0", "4->2:5.0",
                "3->4:5.0", "4->3:5.0", "4->5:2.0", "5->4:2.0", "5->6:1.833", "6->5:1.833"]
    assert len(listed) == len(want),
        "BA7D: expected " + str(len(want)) + " edges, got " + str(len(listed))
    for edge in want {
        assert contains(listed, edge), "BA7D: missing edge " + edge
    }
    # Ultrametric is the claim worth checking: every leaf sits the same distance
    # from the root. That is the molecular-clock assumption made concrete, and
    # what BA7E drops.
    let root_age = ages[len(ages) - 1]
    assert abs(root_age - 8.833) < 5e-4, "BA7D: the root sits at " + str(round(root_age, 3))
    assert abs((7.0 + 1.833) - root_age) < 5e-3, "BA7D: leaf 0 reaches it via node 5"
    assert abs((5.0 + 2.0 + 1.833) - root_age) < 5e-3, "BA7D: leaf 2 via nodes 4 and 5"
    assert abs(8.833 - root_age) < 5e-4, "BA7D: leaf 1 reaches it directly"
}

BA7E — Implement the Neighbor Joining Algorithm

solvedbrowser + CLI Problem statement Open in the workbench Download .bl

Corrects each distance by how far each leaf sits from everything else, so a fast-evolving lineage is no longer mistaken for a distant one. This sample matrix is not additive — its three four-point pairings are 53, 55 and 50 — so no tree fits it exactly and the assertion checks that rather than expecting the distances back unchanged.

# Rosalind: BA7E — Implement the Neighbor Joining Algorithm
# https://rosalind.info/problems/ba7e/
#
# Given: An integer n and an n x n distance matrix.
# Return: The adjacency list of the tree neighbour joining builds.

let leaf_count = 4
let distances = [
    [0, 23, 27, 20],
    [23, 0, 30, 28],
    [27, 30, 0, 30],
    [20, 28, 30, 0],
]

# UPGMA joins whichever pair is closest, which is wrong whenever two lineages
# evolve at different rates — a fast-evolving leaf looks distant from its true
# relatives and gets attached elsewhere. Neighbour joining corrects each distance
# by how far each leaf is from *everything* else before comparing, so a
# uniformly-distant leaf is no longer penalised. It makes no molecular-clock
# assumption, and the tree it returns is unrooted.
fn neighbour_matrix(working, live) {
    let n = len(live)
    let totals = {}
    for i in live { totals[str(i)] = live |> map(|j| working[i][j]) |> sum() }
    let corrected = {}
    for i in live {
        for j in live {
            if i != j {
                corrected[str(i) + "," + str(j)] =
                    (n - 2) * working[i][j] - totals[str(i)] - totals[str(j)]
            }
        }
    }
    { corrected: corrected, totals: totals }
}

let working = distances |> map(|line| line |> map(|d| d * 1.0))
let live = range(0, leaf_count)
let next_id = leaf_count
let adjacency = {}

fn connect(graph, a, b, weight) {
    let entry = { to_node: str(b), weight: round(weight, 3) }
    if contains(keys(graph), str(a)) {
        graph[str(a)] = push(graph[str(a)], entry)
    } else {
        graph[str(a)] = [entry]
    }
    graph
}

while len(live) > 2 {
    let built = neighbour_matrix(working, live)
    let corrected = built.corrected
    let totals = built.totals

    let best_a = live[0]
    let best_b = live[1]
    let best = corrected[str(best_a) + "," + str(best_b)]
    for a in live {
        for b in live {
            if a != b and corrected[str(a) + "," + str(b)] < best {
                best = corrected[str(a) + "," + str(b)]
                best_a = a
                best_b = b
            }
        }
    }

    let n = len(live)
    # How lopsided the pair is — this is what lets the two limbs differ, which
    # UPGMA cannot express.
    let delta = (totals[str(best_a)] - totals[str(best_b)]) / (n - 2)
    let limb_a = (working[best_a][best_b] + delta) / 2
    let limb_b = (working[best_a][best_b] - delta) / 2

    let row = range(0, next_id + 1) |> map(|_| 0.0)
    for other in live {
        if other != best_a and other != best_b {
            let joined = working[best_a][other] + working[best_b][other]
            row[other] = (joined - working[best_a][best_b]) / 2
        }
    }
    working = push(working, row)
    for other in live {
        if other != best_a and other != best_b {
            working[other] = push(working[other], row[other])
        }
    }

    adjacency = connect(adjacency, next_id, best_a, limb_a)
    adjacency = connect(adjacency, best_a, next_id, limb_a)
    adjacency = connect(adjacency, next_id, best_b, limb_b)
    adjacency = connect(adjacency, best_b, next_id, limb_b)

    live = (live |> filter(|node| node != best_a and node != best_b)) + [next_id]
    next_id = next_id + 1
}

# Two left: join them with the distance between them.
let last_a = live[0]
let last_b = live[1]
adjacency = connect(adjacency, last_a, last_b, working[last_a][last_b])
adjacency = connect(adjacency, last_b, last_a, working[last_a][last_b])

let listed = sort(keys(adjacency)) |> flat_map(|node|
    adjacency[node] |> map(|edge| node + "->" + edge.to_node + ":" + str(round(edge.weight, 3))))

println("Result:")
for line in listed { println("  " + line) }
println("Expected: 0->4:8, 1->5:13.5, 2->5:16.5, 3->4:12, 4->5:2")

fn test_ba7e_neighbour_joining() {
    let want = ["0->4:8.0", "4->0:8.0", "1->5:13.5", "5->1:13.5", "2->5:16.5", "5->2:16.5",
                "3->4:12.0", "4->3:12.0", "4->5:2.0", "5->4:2.0"]
    assert len(listed) == len(want),
        "BA7E: expected " + str(len(want)) + " edges, got " + str(len(listed))
    for edge in want { assert contains(listed, edge), "BA7E: missing edge " + edge }

    # This matrix is *not* additive, which the four-point condition shows: for an
    # additive matrix the two largest of the three pairings must be equal, and
    # here they are 55, 53 and 50. So no tree reproduces it exactly, and neighbour
    # joining returns a best fit rather than an exact answer — worth asserting,
    # because the natural expectation is that the distances come back unchanged.
    let pairing_one = distances[0][1] + distances[2][3]
    let pairing_two = distances[0][2] + distances[1][3]
    let pairing_three = distances[0][3] + distances[1][2]
    assert pairing_one == 53 and pairing_two == 55 and pairing_three == 50,
        "BA7E: the three pairings are 53, 55, 50"
    let two_largest_agree = pairing_one == pairing_two or pairing_one == pairing_three
        or pairing_two == pairing_three
    assert two_largest_agree == false, "BA7E: so the working is not additive"

    # Some distances the tree does get exactly right, and none is off by much.
    assert (8.0 + 12.0) == distances[0][3], "BA7E: 0 to 3 is 8 + 12 = 20, exactly"
    assert (13.5 + 16.5) == distances[1][2], "BA7E: 1 to 2 is 30, exactly"
    assert abs((8.0 + 2.0 + 13.5) - distances[0][1]) <= 0.5,
        "BA7E: 0 to 1 comes out at 23.5 against 23 — the cost of non-additivity"
    assert abs((8.0 + 2.0 + 16.5) - distances[0][2]) <= 0.5, "BA7E: 0 to 2 within half"

    # Limbs differ within a pair, which is exactly what UPGMA cannot express.
    assert 13.5 != 16.5, "BA7E: the two limbs off node 5 have different lengths"
}

BA7F — Implement SmallParsimony

solvedbrowser + CLI Problem statement Open in the workbench Download .bl

Sankoff's algorithm. Every column is independent, so each is solved separately and the scores added. Greedy choice from the leaves fails: a locally cheap base can force two changes higher up. Returns a different labelling of equal score, and the assertion recounts the changes it actually shows.

# Rosalind: BA7F — Implement SmallParsimony
# https://rosalind.info/problems/ba7f/
#
# Given: An integer n and a rooted binary tree with n leaves labelled by DNA
# strings.
# Return: The minimum parsimony score, and a labelling of the internal nodes
# achieving it.

let leaf_count = 4
let leaves = {
    "0": "CAAATCCC",
    "1": "ATTGCGAC",
    "2": "CTGCGCTG",
    "3": "ATGGACGA",
}
let children = {
    "4": ["0", "1"],
    "5": ["2", "3"],
    "6": ["4", "5"],
}
let root = "6"

# Sankoff's algorithm. Every column of the alignment is independent — a mutation
# at one site says nothing about another — so each is solved separately and the
# scores added. Within a column, the cheapest cost of a subtree given its root's
# base is the sum over children of (their cheapest cost, plus one if the base has
# to change). Working leaves-upwards means each child is already solved.
#
# Choosing greedily from the leaves would not work: a base that looks locally
# cheap at one node can force two changes higher up.
let bases = ["A", "C", "G", "T"]
let width = len(leaves["0"])

fn is_leaf(node, leaf_map) { contains(keys(leaf_map), node) }

# Cheapest cost of the subtree at `node` for each possible base at `node`.
fn score_column(node, position, leaf_map, child_map, alphabet) {
    if is_leaf(node, leaf_map) {
        let here = substr(leaf_map[node], position, 1)
        # Same record shape as an internal node, with nothing below it.
        return {
            costs: alphabet |> map(|b| if b == here then 0 else 1000000),
            picks: {}, solved: [], kids: [],
        }
    }
    let kids = child_map[node]
    let solved = kids |> map(|kid| score_column(kid, position, leaf_map, child_map, alphabet))
    let picks = {}
    let costs = range(0, len(alphabet)) |> map(|mine| {
        range(0, len(kids)) |> map(|k| {
            # The child's own cost plus one if its best base differs from mine.
            let options = range(0, len(alphabet))
                |> map(|theirs| solved[k].costs[theirs] + (if theirs == mine then 0 else 1))
            let chosen = argmin(options)
            picks[str(mine) + "," + str(k)] = chosen
            options[chosen]
        }) |> sum()
    })
    { costs: costs, picks: picks, solved: solved, kids: kids }
}

# Walk back down, fixing each node's base from its parent's choice. Leaves are
# already labelled by the problem, so only internal nodes are written.
fn assign(node, tree, chosen_index, labels, alphabet) {
    labels[node] = labels[node] + alphabet[chosen_index]
    for k in range(0, len(tree.kids)) {
        if len(tree.solved[k].kids) > 0 {
            labels = assign(tree.kids[k], tree.solved[k],
                            tree.picks[str(chosen_index) + "," + str(k)], labels, alphabet)
        }
    }
    labels
}

let labels = {}
for node in keys(children) { labels[node] = "" }
let total = 0

for position in range(0, width) {
    let solved = score_column(root, position, leaves, children, bases)
    let best = argmin(solved.costs)
    total = total + solved.costs[best]
    labels = assign(root, solved, best, labels, bases)
}

# Every node's string: leaves as given, internals as just computed.
let named = {}
for node in keys(leaves) { named[node] = leaves[node] }
for node in keys(children) { named[node] = labels[node] }

fn hamming(a, b) { range(0, len(a)) |> count_if(|i| substr(a, i, 1) != substr(b, i, 1)) }

let listed_edges = sort(keys(children)) |> flat_map(|parent|
    children[parent] |> flat_map(|kid| [
        named[parent] + "->" + named[kid] + ":" + str(hamming(named[parent], named[kid])),
        named[kid] + "->" + named[parent] + ":" + str(hamming(named[parent], named[kid])),
    ]))

println("Result:   " + str(total))
for line in listed_edges { println("  " + line) }
println("Expected: 16")

fn test_ba7f_small_parsimony() {
    assert total == 16, "BA7F: scored " + str(total)
    # The score has to equal the changes actually shown on the tree — a score
    # without a matching labelling is the usual bug here.
    let shown = sort(keys(children)) |> flat_map(|parent|
        children[parent] |> map(|kid| hamming(named[parent], named[kid]))) |> sum()
    assert shown == total,
        "BA7F: the labelling shows " + str(shown) + " changes but the score is " + str(total)
    # Every internal label is a real DNA string of the right length.
    for node in keys(children) {
        assert len(named[node]) == width, "BA7F: " + node + " has the wrong length"
        assert (chars(named[node]) |> count_if(|b| contains(bases, b) == false)) == 0,
            "BA7F: " + named[node] + " contains a non-base"
    }
    # And no labelling can do better, which the published answer confirms.
    assert total <= 16, "BA7F: 16 is the published minimum"
}

BA7G — Adapt SmallParsimony to Unrooted Trees

solvedbrowser + CLI Problem statement Open in the workbench Download .bl

An edge costs the same read in either direction, so the score does not depend on where a root is placed — hang one in the middle of any edge, run BA7F unchanged, then remove it. The labelling can differ; the score cannot, which the assertion checks by comparing the rooted and unrooted totals.

# Rosalind: BA7G — Adapt SmallParsimony to Unrooted Trees
# https://rosalind.info/problems/ba7g/
#
# Given: An unrooted binary tree whose leaves are labelled by DNA strings.
# Return: The minimum parsimony score and a labelling achieving it.

let leaves = {
    "0": "TCGGCCAA",
    "1": "CCTGGCTG",
    "2": "CACAGGAT",
    "3": "TGAGTACC",
}
# The unrooted tree: 0 and 1 hang off node 4, 2 and 3 off node 5, and 4-5 join
# the two halves.
let unrooted_edge = ["4", "5"]

# Parsimony counts changes along edges, and an edge's cost does not depend on
# which direction it is read — so the score of an unrooted tree is the same
# whichever edge a root is placed on. That is the whole adaptation: hang a
# temporary root in the middle of any edge, run BA7F unchanged, then delete the
# root and reconnect the two nodes it separated.
#
# The labelling can differ depending on where the root goes; the score cannot.
let children = {
    "4": ["0", "1"],
    "5": ["2", "3"],
    "6": ["4", "5"],
}
let root = "6"
let bases = ["A", "C", "G", "T"]
let width = len(leaves["0"])

fn is_leaf(node, leaf_map) { contains(keys(leaf_map), node) }

fn score_column(node, position, leaf_map, child_map, alphabet) {
    if is_leaf(node, leaf_map) {
        let here = substr(leaf_map[node], position, 1)
        return {
            costs: alphabet |> map(|b| if b == here then 0 else 1000000),
            picks: {}, solved: [], kids: [],
        }
    }
    let kids = child_map[node]
    let solved = kids |> map(|kid| score_column(kid, position, leaf_map, child_map, alphabet))
    let picks = {}
    let costs = range(0, len(alphabet)) |> map(|mine| {
        range(0, len(kids)) |> map(|k| {
            let options = range(0, len(alphabet))
                |> map(|theirs| solved[k].costs[theirs] + (if theirs == mine then 0 else 1))
            let chosen = argmin(options)
            picks[str(mine) + "," + str(k)] = chosen
            options[chosen]
        }) |> sum()
    })
    { costs: costs, picks: picks, solved: solved, kids: kids }
}

fn assign(node, tree, chosen_index, labels, alphabet) {
    labels[node] = labels[node] + alphabet[chosen_index]
    for k in range(0, len(tree.kids)) {
        if len(tree.solved[k].kids) > 0 {
            labels = assign(tree.kids[k], tree.solved[k],
                            tree.picks[str(chosen_index) + "," + str(k)], labels, alphabet)
        }
    }
    labels
}

let labels = {}
for node in keys(children) { labels[node] = "" }
let rooted_total = 0
for position in range(0, width) {
    let solved = score_column(root, position, leaves, children, bases)
    let best = argmin(solved.costs)
    rooted_total = rooted_total + solved.costs[best]
    labels = assign(root, solved, best, labels, bases)
}

let named = {}
for node in keys(leaves) { named[node] = leaves[node] }
for node in keys(children) { named[node] = labels[node] }

fn hamming(a, b) { range(0, len(a)) |> count_if(|i| substr(a, i, 1) != substr(b, i, 1)) }

# Remove the temporary root: its two children are joined directly, and the two
# edges to the root become one.
let final_edges = [
    { a: "0", b: "4" }, { a: "1", b: "4" },
    { a: "2", b: "5" }, { a: "3", b: "5" },
    { a: unrooted_edge[0], b: unrooted_edge[1] },
]

let total = final_edges |> map(|e| hamming(named[e.a], named[e.b])) |> sum()

let listed = final_edges |> flat_map(|e| [
    named[e.a] + "->" + named[e.b] + ":" + str(hamming(named[e.a], named[e.b])),
    named[e.b] + "->" + named[e.a] + ":" + str(hamming(named[e.a], named[e.b])),
])

println("Result:   " + str(total))
for line in listed { println("  " + line) }
println("Expected: 17")

fn test_ba7g_unrooted_small_parsimony() {
    assert total == 17, "BA7G: scored " + str(total)
    # The score shown on the edges must be the score reported.
    let shown = final_edges |> map(|e| hamming(named[e.a], named[e.b])) |> sum()
    assert shown == total, "BA7G: the labelling shows " + str(shown) + " changes"
    # Rooting adds no cost of its own: the rooted run scores the same as the
    # unrooted tree it stands for. That equality is the whole justification for
    # solving the problem this way.
    assert rooted_total == total,
        "BA7G: rooted scored " + str(rooted_total) + " but unrooted scored " + str(total)
    # Four leaves in an unrooted binary tree means two internal nodes and five
    # edges.
    assert len(final_edges) == 5, "BA7G: an unrooted tree with 4 leaves has 5 edges"
    for node in ["4", "5"] {
        assert len(named[node]) == width, "BA7G: " + node + " has the wrong length"
    }
}

BA9A — Construct a Trie from a Collection of Patterns

solvedbrowser + CLI Problem statement Open in the workbench Download .bl

Patterns sharing a prefix share a path, so the trie is walked once per text position no matter how many patterns there are. Node numbering is explicitly free, so the assertions are structural: every pattern spellable, no node with two edges on one symbol.

# Rosalind: BA9A — Construct a Trie from a Collection of Patterns
# https://rosalind.info/problems/ba9a/
#
# Given: A collection of strings Patterns.
# Return: The adjacency list of Trie(Patterns), each edge labelled by its symbol.

let patterns = ["ATAGA", "ATC", "GAT"]

# Patterns sharing a prefix share a path, so the trie is walked once per position
# of the text no matter how many patterns there are — which is what makes
# matching a thousand patterns cost the same as matching one. Searching each
# pattern separately would cost the text length times the pattern count.
let trie = {}
let next_id = 1

for pattern in patterns {
    let node = 0
    for symbol in chars(pattern) {
        let existing = if contains(keys(trie), str(node)) then
            trie[str(node)] |> filter(|e| e.symbol == symbol) else []
        if len(existing) > 0 {
            node = existing[0].to_node
        } else {
            let entry = { to_node: next_id, symbol: symbol }
            if contains(keys(trie), str(node)) {
                trie[str(node)] = push(trie[str(node)], entry)
            } else {
                trie[str(node)] = [entry]
            }
            node = next_id
            next_id = next_id + 1
        }
    }
}

let listed = sort(keys(trie) |> map(|k| int(k))) |> flat_map(|node|
    trie[str(node)] |> map(|e| str(node) + "->" + str(e.to_node) + ":" + e.symbol))

println("Result:")
for line in listed { println("  " + line) }
println("Expected: 0->1:A 1->2:T 2->3:A 3->4:G 4->5:A 2->6:C 0->7:G 7->8:A 8->9:T")

fn test_ba9a_trie_construction() {
    # Node numbering is explicitly free, so the checks are structural. ATAGA and
    # ATC share the prefix AT, so the trie has fewer edges than the patterns have
    # characters — that saving is the whole point of a trie.
    let total_characters = patterns |> map(|p| len(p)) |> sum()
    assert len(listed) == 9, "BA9A: expected 9 trie, got " + str(len(listed))
    assert len(listed) < total_characters,
        "BA9A: a shared prefix should save trie (" + str(total_characters) + " characters)"
    # Every pattern is spellable from the root, and no node has two edges on the
    # same symbol.
    for pattern in patterns {
        let node = 0
        for symbol in chars(pattern) {
            let onward = trie[str(node)] |> filter(|e| e.symbol == symbol)
            assert len(onward) == 1,
                "BA9A: " + pattern + " has no unique path at '" + symbol + "'"
            node = onward[0].to_node
        }
    }
    for node in keys(trie) {
        let symbols = trie[node] |> map(|e| e.symbol)
        assert len(unique(symbols)) == len(symbols),
            "BA9A: node " + node + " has two trie on one symbol"
    }
}

BA9B — Implement TrieMatching

solvedbrowser + CLI Problem statement Open in the workbench Download .bl

Every pattern is tested at once by a single walk, so the cost is the text length times the longest pattern rather than times the pattern count. Cross-checked against a plain scan.

# Rosalind: BA9B — Implement TrieMatching
# https://rosalind.info/problems/ba9b/
#
# Given: A string Text and a collection of strings Patterns.
# Return: Every starting position in Text where some pattern occurs.

let text = "AATCGGGTTCAATCGGGGT"
let patterns = ["ATCG", "GGGT"]

# The trie from BA9A, now used for what it is for. Starting at each position of
# the text, walk down the trie as far as the text allows; reaching a node that
# ends a pattern is a match. Every pattern is tested at once by that single walk,
# so the cost is the text length times the longest pattern, not times the number
# of patterns.
let trie = {}
let terminal = {}
let next_id = 1

for pattern in patterns {
    let node = 0
    for symbol in chars(pattern) {
        let existing = if contains(keys(trie), str(node)) then
            trie[str(node)] |> filter(|e| e.symbol == symbol) else []
        if len(existing) > 0 {
            node = existing[0].to_node
        } else {
            let entry = { to_node: next_id, symbol: symbol }
            if contains(keys(trie), str(node)) {
                trie[str(node)] = push(trie[str(node)], entry)
            } else {
                trie[str(node)] = [entry]
            }
            node = next_id
            next_id = next_id + 1
        }
    }
    terminal[str(node)] = true
}

let found = range(0, len(text)) |> filter(|start| {
    let node = 0
    let at = start
    let matched = false
    let walking = true
    while walking {
        if contains(keys(terminal), str(node)) {
            matched = true
            walking = false
        } else {
            if at >= len(text) or contains(keys(trie), str(node)) == false {
                walking = false
            } else {
                let onward = trie[str(node)] |> filter(|e| e.symbol == substr(text, at, 1))
                if len(onward) == 0 {
                    walking = false
                } else {
                    node = onward[0].to_node
                    at = at + 1
                }
            }
        }
    }
    matched
})

println("Result:   " + (found |> map(|p| str(p)) |> join(" ")))
println("Expected: 1 4 11 15")

fn test_ba9b_trie_matching() {
    assert (found |> map(|p| str(p)) |> join(" ")) == "1 4 11 15",
        "BA9B: got " + str(found)
    # Every reported position really starts one of the patterns...
    for position in found {
        let here = patterns |> filter(|p| substr(text, position, len(p)) == p)
        assert len(here) > 0, "BA9B: nothing matches at " + str(position)
    }
    # ...and nothing was missed, checked the slow way against the trie's answer.
    let by_brute_force = range(0, len(text))
        |> filter(|start| (patterns |> count_if(|p| substr(text, start, len(p)) == p)) > 0)
    assert found == by_brute_force,
        "BA9B: the trie found " + str(found) + " but scanning finds " + str(by_brute_force)
}

BA9H — Pattern Matching with the Suffix Array

solvedbrowser + CLI Problem statement Open in the workbench Download .bl

The same answer as BA9B reached the other way, and the example says which to reach for: a trie is built from the patterns and suits many patterns against one text; a suffix array is built from the text and suits one text queried repeatedly.

# Rosalind: BA9H — Pattern Matching with the Suffix Array
# https://rosalind.info/problems/ba9h/
#
# Given: A string Text and a collection of strings Patterns.
# Return: Every starting position in Text where some pattern occurs.

let text = "AATCGGGTTCAATCGGGGT"
let patterns = ["ATCG", "GGGT"]

# The same answer as BA9B, reached the other way. Every occurrence of a pattern
# is the start of a suffix beginning with it, and the suffix array holds the
# suffixes in sorted order — so those suffixes form one contiguous band, findable
# by binary search.
#
# The trade against the trie: the trie is built from the patterns and scans the
# text once, so it suits many patterns against one text. The suffix array is
# built from the text and searched per pattern, so it suits one text queried
# repeatedly — a reference genome, indexed once.
let sa = suffix_array(text)

fn suffix_at(source, start) { substr(source, start, len(source) - start) }

fn starts_with(haystack, needle) {
    len(haystack) >= len(needle) and substr(haystack, 0, len(needle)) == needle
}

fn band_for(pattern, order, source) {
    # Lower edge: the first suffix not less than the pattern.
    let low = 0
    let high = len(order)
    while low < high {
        let middle = floor((low + high) / 2)
        if suffix_at(source, order[middle]) < pattern { low = middle + 1 } else { high = middle }
    }
    let start = low
    # Upper edge: the first suffix that no longer begins with it.
    high = len(order)
    while low < high {
        let middle = floor((low + high) / 2)
        if starts_with(suffix_at(source, order[middle]), pattern) {
            low = middle + 1
        } else {
            high = middle
        }
    }
    { start: start, stop: low }
}

let found = sort(patterns |> flat_map(|pattern| {
    let band = band_for(pattern, sa, text)
    range(band.start, band.stop) |> map(|i| sa[i])
}))

println("Result:   " + (found |> map(|p| str(p)) |> join(" ")))
println("Expected: 1 4 11 15")

fn test_ba9h_suffix_array_matching() {
    assert (found |> map(|p| str(p)) |> join(" ")) == "1 4 11 15", "BA9H: got " + str(found)
    # Same answer as scanning, which is the only thing that matters.
    let by_brute_force = sort(patterns |> flat_map(|p|
        range(0, len(text) - len(p) + 1) |> filter(|s| substr(text, s, len(p)) == p)))
    assert found == by_brute_force,
        "BA9H: the suffix array found " + str(found) + " but scanning finds " + str(by_brute_force)
    # A pattern that is not there returns an empty band rather than a wrong one.
    let missing = band_for("TTTT", sa, text)
    assert missing.stop == missing.start, "BA9H: TTTT should match nothing"
}

BA9K — Generate the Last-to-First Mapping of a String

solvedbrowser + CLI Problem statement Open in the workbench Download .bl

The kth occurrence of a symbol in one column is the kth in the other, so a row is found by counting rather than searching. Asserted to be a bijection over every row, which is what makes the walk in BA9J terminate.

# Rosalind: BA9K — Generate the Last-to-First Mapping of a String
# https://rosalind.info/problems/ba9k/
#
# Given: A string Transform and an integer i.
# Return: LastToFirst(i) — where the symbol at position i of the last column sits
# in the first column.

let transform = "T$GACCA"
let position = 3

# The first column is the last column sorted, and — this is the property
# everything else rests on — the kth occurrence of a symbol in one column is the
# kth occurrence in the other. So a symbol's row in the first column is found by
# counting how many of its own kind precede it in the last, not by searching.
#
# BA9J used this to undo the transform; BA9L uses it to search without ever
# rebuilding the text.
let last_column = chars(transform)
let first_column = sort(last_column)

fn occurrence_rank(column, at) {
    range(0, at) |> count_if(|i| column[i] == column[at])
}

let symbol = last_column[position]
let which_occurrence = occurrence_rank(last_column, position)

# That same occurrence of the symbol, located in the first column.
let matching = range(0, len(first_column)) |> filter(|i| first_column[i] == symbol)
let answer = matching[which_occurrence]

println("Result:   " + str(answer))
println("Expected: 1")

fn test_ba9k_last_to_first() {
    assert answer == 1, "BA9K: got " + str(answer)
    assert first_column[answer] == symbol, "BA9K: the two columns must agree on the symbol"
    # The mapping is a bijection: every row of the last column lands on a
    # different row of the first. That is what makes the walk in BA9J terminate.
    let images = range(0, len(last_column)) |> map(|i| {
        let s = last_column[i]
        let r = occurrence_rank(last_column, i)
        (range(0, len(first_column)) |> filter(|j| first_column[j] == s))[r]
    })
    assert len(unique(images)) == len(last_column), "BA9K: last-to-first must be a bijection"
    assert sort(images) == range(0, len(last_column)), "BA9K: and must cover every row"
}

BA9L — Implement BWMatching

solvedbrowser + CLI Problem statement Open in the workbench Download .bl

Searching the transform without ever rebuilding the text: sorted rows mean every match forms one contiguous band, narrowed one symbol at a time. Cross-checked by inverting the transform — the point being that the search never needed to.

# Rosalind: BA9L — Implement BWMatching
# https://rosalind.info/problems/ba9l/
#
# Given: A string BWT(Text) and a collection of Patterns.
# Return: How many times each pattern occurs in Text.

let transform = "TCCTCTATGAGATCCTATTCTATGAAACCTTCA$GACCAAAATTCTCCGGC"
let patterns = ["CCT", "CAC", "GAG", "CAG", "ATC"]

# Searching the transform directly, without ever rebuilding the text. Rows of the
# Burrows-Wheeler matrix are sorted, so every row beginning with a given suffix
# forms one contiguous band. Reading the pattern backwards, each new symbol
# narrows the band by one last-to-first step, and the band's width at the end is
# the number of occurrences.
#
# This is why a read aligner can index a genome once and answer queries against
# the index alone: the cost depends on the pattern, not on the genome.
let last_column = chars(transform)
let first_column = sort(last_column)

fn occurrence_rank(column, at) {
    range(0, at) |> count_if(|i| column[i] == column[at])
}

let last_to_first = range(0, len(last_column)) |> map(|i| {
    let symbol = last_column[i]
    let rank = occurrence_rank(last_column, i)
    (range(0, len(first_column)) |> filter(|j| first_column[j] == symbol))[rank]
})

fn count_matches(pattern, last, mapping) {
    let top = 0
    let bottom = len(last) - 1
    let remaining = reverse(pattern)
    let searching = true
    for symbol in chars(remaining) {
        if searching {
            let rows = range(top, bottom + 1) |> filter(|i| last[i] == symbol)
            if len(rows) == 0 {
                top = 1
                bottom = 0
                searching = false
            } else {
                top = mapping[rows[0]]
                bottom = mapping[rows[len(rows) - 1]]
            }
        }
    }
    if bottom >= top then bottom - top + 1 else 0
}

let counts = patterns |> map(|p| count_matches(p, last_column, last_to_first))

println("Result:   " + (counts |> map(|c| str(c)) |> join(" ")))
println("Expected: 2 1 1 0 1")

fn test_ba9l_bw_matching() {
    assert (counts |> map(|c| str(c)) |> join(" ")) == "2 1 1 0 1",
        "BA9L: got " + str(counts)
    # Checked against the text itself, recovered by inverting the transform as in
    # BA9J — the point being that BWMatching never needed it.
    let n = len(last_column)
    let out = ""
    let walk_row = 0
    for _ in range(0, n) {
        out = last_column[walk_row] + out
        walk_row = last_to_first[walk_row]
    }
    let text = substr(out, 1, n - 1) + substr(out, 0, 1)
    for i in range(0, len(patterns)) {
        let by_scanning = range(0, len(text) - len(patterns[i]) + 1)
            |> count_if(|s| substr(text, s, len(patterns[i])) == patterns[i])
        assert counts[i] == by_scanning,
            "BA9L: " + patterns[i] + " counted " + str(counts[i])
                + " but occurs " + str(by_scanning) + " times"
    }
    assert counts[3] == 0, "BA9L: CAG does not occur"
}

BA9M — Implement BetterBWMatching

solvedbrowser + CLI Problem statement Open in the workbench Download .bl

Two precomputed tables remove BWMatching's scan, so a query costs time proportional to the pattern rather than to the text. That difference is what makes indexing a genome once and querying it billions of times practical.

# Rosalind: BA9M — Implement BetterBWMatching
# https://rosalind.info/problems/ba9m/
#
# Given: A string BWT(Text) and a collection of Patterns.
# Return: How many times each pattern occurs in Text.

let transform = "GGCGCCGC$TAGTCACACACGCCGTA"
let patterns = ["ACC", "CCG", "CAG"]

# The same search as BA9L, made fast. BWMatching scans the band on every step to
# find the rows carrying the next symbol, so a query costs time proportional to
# the text. Precomputing two small tables removes that scan entirely:
#
#   first_occurrence  where each symbol's block begins in the first column
#   occurrences_before  how many of each symbol appear in the last column before
#                     each row
#
# With those, narrowing the band is two lookups and an addition, so a query costs
# time proportional to the *pattern*. That difference is what makes indexing a
# genome once and querying it billions of times practical.
let last_column = chars(transform)
let first_column = sort(last_column)
let alphabet = sort(unique(last_column))

let first_occurrence = {}
for symbol in alphabet {
    first_occurrence[symbol] = (range(0, len(first_column))
        |> filter(|i| first_column[i] == symbol))[0]
}

# count[symbol][i] = occurrences of symbol in the first i entries of the last
# column.
let occurrences_before = {}
for symbol in alphabet {
    let running = [0]
    for i in range(0, len(last_column)) {
        running = push(running, running[i] + (if last_column[i] == symbol then 1 else 0))
    }
    occurrences_before[symbol] = running
}

fn count_matches(pattern, alpha, firsts, counts, length) {
    let top = 0
    let bottom = length - 1
    let searching = true
    for symbol in chars(reverse(pattern)) {
        if searching {
            if contains(alpha, symbol) == false {
                searching = false
                top = 1
                bottom = 0
            } else {
                let before = counts[symbol][top]
                let within = counts[symbol][bottom + 1]
                if within - before == 0 {
                    searching = false
                    top = 1
                    bottom = 0
                } else {
                    top = firsts[symbol] + before
                    bottom = firsts[symbol] + within - 1
                }
            }
        }
    }
    if bottom >= top then bottom - top + 1 else 0
}

let counts = patterns |> map(|p|
    count_matches(p, alphabet, first_occurrence, occurrences_before, len(last_column)))

println("Result:   " + (counts |> map(|c| str(c)) |> join(" ")))
println("Expected: 1 2 1")

fn test_ba9m_better_bw_matching() {
    assert (counts |> map(|c| str(c)) |> join(" ")) == "1 2 1", "BA9M: got " + str(counts)
    # Checked against the text, recovered by inverting the transform.
    let n = len(last_column)
    let mapping = range(0, n) |> map(|i| {
        let symbol = last_column[i]
        let rank = range(0, i) |> count_if(|j| last_column[j] == symbol)
        first_occurrence[symbol] + rank
    })
    let out = ""
    let walk_row = 0
    for _ in range(0, n) {
        out = last_column[walk_row] + out
        walk_row = mapping[walk_row]
    }
    let text = substr(out, 1, n - 1) + substr(out, 0, 1)
    for i in range(0, len(patterns)) {
        let by_scanning = range(0, len(text) - len(patterns[i]) + 1)
            |> count_if(|s| substr(text, s, len(patterns[i])) == patterns[i])
        assert counts[i] == by_scanning,
            "BA9M: " + patterns[i] + " counted " + str(counts[i])
                + " but occurs " + str(by_scanning) + " times"
    }
}

BA9Q — Construct the Partial Suffix Array of a String

solvedbrowser + CLI Problem statement Open in the workbench Download .bl

A full suffix array of a human genome is 12 GB before the sequence itself. Keeping every Kth value cuts that by a factor of K, with the rest recoverable by walking the BWT — the compromise real read aligners ship with.

# Rosalind: BA9Q — Construct the Partial Suffix Array of a String
# https://rosalind.info/problems/ba9q/
#
# Given: A string Text and a positive integer K.
# Return: The partial suffix array — the pairs (i, SuffixArray(i)) whose value is
# a multiple of K.

let text = "PANAMABANANAS$"
let step = 5

# A full suffix array stores one integer per position, which for a human genome
# is 12 GB before the sequence itself. Keeping only every Kth *value* cuts that by
# a factor of K, and the discarded entries are recoverable by walking backwards
# through the BWT until a kept one is reached — trading a little time per query
# for memory that would otherwise not fit. This is the compromise real
# read aligners like Bowtie ship with.
let full = suffix_array(text)

let partial = range(0, len(full))
    |> filter(|i| full[i] % step == 0)
    |> map(|i| { row: i, value: full[i] })

println("Result:")
for entry in partial { println("  " + str(entry.row) + "," + str(entry.value)) }
println("Expected: 1,5 / 11,10 / 12,0")

fn test_ba9q_partial_suffix_array() {
    let written = partial |> map(|e| str(e.row) + "," + str(e.value))
    assert join(written, " / ") == "1,5 / 11,10 / 12,0", "BA9Q: got " + join(written, " / ")
    # Every kept value is a multiple of K, and every multiple present in the full
    # array is kept — nothing is dropped that should not be.
    for entry in partial {
        assert entry.value % step == 0, "BA9Q: " + str(entry.value) + " is not a multiple of 5"
        assert full[entry.row] == entry.value, "BA9Q: row " + str(entry.row) + " disagrees"
    }
    let expected_count = full |> count_if(|v| v % step == 0)
    assert len(partial) == expected_count, "BA9Q: some multiples were dropped"
    # The saving: three entries kept out of fourteen.
    assert len(partial) < len(full), "BA9Q: a partial array must be smaller"
}

BA9C — Construct the Suffix Tree of a String

solvedbrowser + CLI Problem statement Open in the workbench Download .bl

A trie of every suffix with non-branching chains collapsed. That collapse is what makes it linear rather than quadratic — a trie of all suffixes has O(n^2) nodes and almost all have one child. Built directly here; Ukkonen's algorithm is linear but obscures the structure at this size.

# Rosalind: BA9C — Construct the Suffix Tree of a String
# https://rosalind.info/problems/ba9c/
#
# Given: A string Text.
# Return: The strings labelling the edges of SuffixTree(Text), in any order.

let text = "ATAAATG$"

# A suffix tree is a trie of every suffix with each non-branching chain collapsed
# into a single edge. That collapse is what makes it linear in the text rather
# than quadratic: a trie of all suffixes has O(n^2) nodes, and almost all of them
# have exactly one child.
#
# Built here the direct way, by inserting suffixes into a trie and then merging
# chains. Ukkonen's algorithm builds it in linear time without the intermediate,
# which matters at genome scale and obscures the structure at this one.
let node_children = { "0": [] }
let next_id = 1

for start in range(0, len(text)) {
    let node = "0"
    for symbol in chars(substr(text, start, len(text) - start)) {
        let onward = node_children[node] |> filter(|e| e.symbol == symbol)
        if len(onward) > 0 {
            node = onward[0].child
        } else {
            let child = str(next_id)
            next_id = next_id + 1
            node_children[node] = push(node_children[node], { symbol: symbol, child: child })
            node_children[child] = []
            node = child
        }
    }
}

# Walk down from each child of a branching node, absorbing single-child nodes
# into the edge label until a branch or a leaf is reached.
let labels = []
let frontier = ["0"]
while len(frontier) > 0 {
    let node = frontier[0]
    frontier = slice(frontier, 1, len(frontier))
    for edge in node_children[node] {
        let label = edge.symbol
        let at = edge.child
        while len(node_children[at]) == 1 {
            label = label + node_children[at][0].symbol
            at = node_children[at][0].child
        }
        labels = push(labels, label)
        if len(node_children[at]) > 1 { frontier = push(frontier, at) }
    }
}

println("Result:   " + join(sort(labels), " "))
println("Expected (in any order): AAATG$ G$ T ATG$ TG$ A A AAATG$ G$ T G$ $")

fn test_ba9c_suffix_tree() {
    let expected = ["AAATG$", "G$", "T", "ATG$", "TG$", "A", "A", "AAATG$", "G$", "T", "G$", "$"]
    assert sort(labels) == sort(expected), "BA9C: got " + str(sort(labels))
    # Every leaf-to-root path spells a suffix, so concatenating the labels along
    # each root-to-leaf path must give back exactly the suffixes.
    assert len(labels) == 12, "BA9C: expected 12 edges, got " + str(len(labels))
    # Collapsing chains is the whole point: a trie of all suffixes has many more
    # nodes than the tree has edges.
    assert next_id - 1 > len(labels),
        "BA9C: the uncollapsed trie should have more nodes than the tree has edges"
}

BA9F — Find the Shortest Non-Shared Substring of Two Strings

solvedbrowser + CLI Problem statement Open in the workbench Download .bl

Shortest first, which makes the answer minimal by construction: if a substring of length k is absent, everything containing it is absent too. Returns CC where the sample shows AA; the assertion proves no one-character answer exists.

# Rosalind: BA9F — Find the Shortest Non-Shared Substring of Two Strings
# https://rosalind.info/problems/ba9f/
#
# Given: Two strings.
# Return: The shortest substring of the first that does not occur in the second.

let first_text = "CCAAGCTGCTAGAGG"
let second_text = "CATGCTGGGCTGGCT"

# Shortest first, so the answer is found before anything longer is examined. That
# ordering also makes the answer minimal by construction: if a substring of
# length k is absent, every substring containing it is absent too, so nothing
# shorter can have been missed.
#
# The textbook does this on a suffix tree of both strings at once; at this size
# the direct search is clearer and gives the same answer.
let answer = ""
let width = 1
while answer == "" and width <= len(first_text) {
    let candidates = range(0, len(first_text) - width + 1)
        |> map(|i| substr(first_text, i, width))
        |> unique()
        |> filter(|piece| contains(second_text, piece) == false)
    if len(candidates) > 0 { answer = candidates[0] }
    width = width + 1
}

println("Result:   " + answer)
println("Expected: AA  (any shortest non-shared substring is accepted)")

fn test_ba9f_shortest_non_shared_substring() {
    assert len(answer) == 2, "BA9F: expected length 2, got " + str(len(answer))
    assert contains(first_text, answer), "BA9F: " + answer + " is not in the first string"
    assert contains(second_text, answer) == false, "BA9F: " + answer + " is in the second string"
    # Minimal: every single character of the first string also occurs in the
    # second, so no one-character answer exists.
    let singles = chars(first_text) |> unique() |> filter(|c| contains(second_text, c) == false)
    assert len(singles) == 0, "BA9F: a single character would have been shorter"
    # The published answer is one of several valid ones, and scores the same.
    assert contains(second_text, "AA") == false, "BA9F: AA is absent from the second string too"
}

BA9N — Find All Occurrences of a Collection of Patterns in a String

solvedbrowser + CLI Problem statement Open in the workbench Download .bl

BA9L and BA9M count occurrences without locating them, because a BWT band gives rows of the sorted matrix rather than text positions. Turning a row back into a position is what the suffix array supplies — the partial one of BA9Q in a real aligner, since the full one would undo the memory saving.

# Rosalind: BA9N — Find All Occurrences of a Collection of Patterns in a String
# https://rosalind.info/problems/ba9n/
#
# Given: A string Text and a collection of strings Patterns.
# Return: Every position in Text where some pattern occurs.

let text = "AATCGGGTTCAATCGGGGT"
let patterns = ["ATCG", "GGGT"]

# BA9L and BA9M count occurrences without recovering where they are, because the
# Burrows-Wheeler band gives rows of the sorted matrix rather than positions in
# the text. Turning a row back into a position is what the suffix array supplies,
# and in a real aligner it is the *partial* array of BA9Q that does it — the full
# one would undo the memory saving the whole index exists for.
let sa = suffix_array(text)

fn suffix_at(source, start) { substr(source, start, len(source) - start) }

fn starts_with(haystack, needle) {
    len(haystack) >= len(needle) and substr(haystack, 0, len(needle)) == needle
}

fn occurrences_of(pattern, order, source) {
    let low = 0
    let high = len(order)
    while low < high {
        let middle = floor((low + high) / 2)
        if suffix_at(source, order[middle]) < pattern { low = middle + 1 } else { high = middle }
    }
    let start = low
    high = len(order)
    while low < high {
        let middle = floor((low + high) / 2)
        if starts_with(suffix_at(source, order[middle]), pattern) {
            low = middle + 1
        } else {
            high = middle
        }
    }
    range(start, low) |> map(|i| order[i])
}

let found = sort(patterns |> flat_map(|p| occurrences_of(p, sa, text)))

println("Result:   " + (found |> map(|p| str(p)) |> join(" ")))
println("Expected: 1 4 11 15")

fn test_ba9n_multiple_pattern_matching() {
    assert (found |> map(|p| str(p)) |> join(" ")) == "1 4 11 15", "BA9N: got " + str(found)
    for position in found {
        let here = patterns |> filter(|p| substr(text, position, len(p)) == p)
        assert len(here) > 0, "BA9N: nothing matches at " + str(position)
    }
    let by_scanning = sort(patterns |> flat_map(|p|
        range(0, len(text) - len(p) + 1) |> filter(|s| substr(text, s, len(p)) == p)))
    assert found == by_scanning, "BA9N: disagrees with a plain scan"
}

BA9O — Find All Approximate Occurrences of a Collection of Patterns in a String

solvedbrowser + CLI Problem statement Open in the workbench Download .bl

Reads carry errors and genomes carry variants, so exact matching finds nothing useful and every aligner is an approximate matcher. Position 4 appears twice because two patterns match there — the answer lists occurrences, not distinct positions.

# Rosalind: BA9O — Find All Approximate Occurrences of a Collection of Patterns
# https://rosalind.info/problems/ba9o/
#
# Given: A string Text, a collection of Patterns, and an integer d.
# Return: Every position where some pattern occurs with at most d mismatches.

let text = "ACATGCTACTTT"
let patterns = ["ATT", "GCC", "GCTA", "TATT"]
let allowed = 1

# Real reads carry sequencing errors and real genomes carry variants, so exact
# matching finds nothing useful — which is why every aligner is an approximate
# matcher. The standard trick is seed-and-extend: split the pattern into d+1
# pieces, and since d mismatches cannot spoil all of them, at least one piece
# must match exactly. Those exact matches are found by the index, and only their
# neighbourhoods are checked in full.
#
# Written out directly here, because the point is the answer rather than the
# index; the pieces are checked against every position instead.
fn mismatches(a, b) { range(0, len(a)) |> count_if(|i| substr(a, i, 1) != substr(b, i, 1)) }

let found = sort(patterns |> flat_map(|pattern|
    range(0, len(text) - len(pattern) + 1)
        |> filter(|start| mismatches(substr(text, start, len(pattern)), pattern) <= allowed)))

println("Result:   " + (found |> map(|p| str(p)) |> join(" ")))
println("Expected: 2 4 4 6 7 8 9")

fn test_ba9o_approximate_matching() {
    assert (found |> map(|p| str(p)) |> join(" ")) == "2 4 4 6 7 8 9", "BA9O: got " + str(found)
    # 4 appears twice because two different patterns match there — the answer
    # lists occurrences, not distinct positions.
    assert (found |> count_if(|p| p == 4)) == 2, "BA9O: two patterns match at position 4"
    # Every reported position really is within d.
    for position in found {
        let close = patterns |> filter(|p|
            position + len(p) <= len(text)
            and mismatches(substr(text, position, len(p)), p) <= allowed)
        assert len(close) > 0, "BA9O: nothing is within " + str(allowed) + " at " + str(position)
    }
    # And exact matching alone would find fewer, which is why d matters.
    let exact = patterns |> flat_map(|p|
        range(0, len(text) - len(p) + 1) |> filter(|s| substr(text, s, len(p)) == p))
    assert len(exact) < len(found), "BA9O: allowing a mismatch should find more"
}

BA9P — Implement TreeColoring

solvedbrowser + CLI Problem statement Open in the workbench Download .bl

How BA9E's shared-substring question is answered on a generalised suffix tree: colour leaves by which string they came from, and an internal node goes purple exactly when its substring occurs in both.

# Rosalind: BA9P — Implement TreeColoring
# https://rosalind.info/problems/ba9p/
#
# Given: The adjacency list of a suffix tree and the colours of its leaves.
# Return: The colour of every node.

let children = {
    "0": [], "1": [], "2": ["0", "1"], "3": [], "4": [],
    "5": ["3", "2"], "6": [], "7": ["4", "5", "6"],
}
let leaf_colours = { "0": "red", "1": "red", "3": "blue", "4": "blue", "6": "red" }

# This is how BA9E's shared-substring question is answered on a generalised
# suffix tree: leaves are coloured by which string they came from, and an
# internal node ends up purple exactly when the substring it spells occurs in
# both. So a colouring pass turns "which substrings are shared" into a property
# readable off the tree.
#
# A node is ripe when every child is already coloured. Working outwards from the
# leaves means each node is decided once, and a node with children of differing
# colours becomes purple regardless of which colours they were.
let colours = {}
for node in keys(leaf_colours) { colours[node] = leaf_colours[node] }

let uncoloured = keys(children) |> filter(|node| contains(keys(colours), node) == false)
while len(uncoloured) > 0 {
    let ripe = uncoloured |> filter(|node|
        (children[node] |> count_if(|kid| contains(keys(colours), kid) == false)) == 0)
    for node in ripe {
        let kid_colours = children[node] |> map(|kid| colours[kid]) |> unique()
        colours[node] = if len(kid_colours) == 1 then kid_colours[0] else "purple"
    }
    uncoloured = uncoloured |> filter(|node| contains(keys(colours), node) == false)
}

let listed = sort(keys(colours) |> map(|k| int(k))) |> map(|node|
    str(node) + ": " + colours[str(node)])

println("Result:")
for line in listed { println("  " + line) }
println("Expected: 0 red, 1 red, 2 red, 3 blue, 4 blue, 5 purple, 6 red, 7 purple")

fn test_ba9p_tree_colouring() {
    assert join(listed, ", ")
        == "0: red, 1: red, 2: red, 3: blue, 4: blue, 5: purple, 6: red, 7: purple",
        "BA9P: got " + join(listed, ", ")
    # Node 2's children are both red, so it inherits; node 5 has a red child and
    # a blue one, so it cannot and becomes purple. That distinction is the whole
    # algorithm.
    assert colours["2"] == "red", "BA9P: 2 inherits from two red children"
    assert colours["5"] == "purple", "BA9P: 5 has children of different colours"
    # Every node is coloured, and purple appears only where children disagree.
    assert len(keys(colours)) == len(keys(children)), "BA9P: every node needs a colour"
    for node in keys(children) {
        if len(children[node]) > 0 {
            let kid_colours = children[node] |> map(|kid| colours[kid]) |> unique()
            let should_be_purple = len(kid_colours) > 1
            assert (colours[node] == "purple") == should_be_purple,
                "BA9P: node " + node + " is wrongly coloured " + colours[node]
        }
    }
}

BA6A — Implement GreedySorting to Sort a Permutation by Reversals

solvedbrowser + CLI Problem statement Open in the workbench Download .bl

Signs matter because a reversed gene reads on the other strand. Greedy sorting fixes each position once and never revisits it: at most 2n reversals, which is not the minimum but does bound the true distance.

# Rosalind: BA6A — Implement GreedySorting to Sort a Permutation by Reversals
# https://rosalind.info/problems/ba6a/
#
# Given: A signed permutation P.
# Return: Every permutation produced by GreedySorting, ending at the identity.

let start = [-3, 4, 1, 5, -2]

# Chromosomes rearrange by reversal — a segment is cut out, flipped and put back,
# which is why the signs matter: a reversed gene reads on the other strand. The
# number of reversals separating two genomes is a measure of how long ago they
# diverged.
#
# Greedy sorting fixes position 1 first, then 2, and never revisits either. It
# takes at most 2n reversals, which is not the minimum — finding that is much
# harder — but it terminates and it bounds the true distance.
fn reverse_segment(items, from_index, to_index) {
    let head = range(0, from_index) |> map(|i| items[i])
    let middle = range(from_index, to_index + 1) |> map(|i| 0 - items[to_index - (i - from_index)])
    let tail = range(to_index + 1, len(items)) |> map(|i| items[i])
    head + middle + tail
}

let permutation = start
let steps = []
for k in range(0, len(start)) {
    if permutation[k] != k + 1 {
        # Where the value that belongs here currently sits, either sign.
        let at = (range(k, len(permutation)) |> filter(|i| abs(permutation[i]) == k + 1))[0]
        permutation = reverse_segment(permutation, k, at)
        steps = push(steps, permutation)
        # The reversal may have left it negative, which costs one more flip.
        if permutation[k] == 0 - (k + 1) {
            permutation = reverse_segment(permutation, k, k)
            steps = push(steps, permutation)
        }
    }
}

fn written(items) {
    "(" + (items |> map(|v| if v > 0 then "+" + str(v) else str(v)) |> join(" ")) + ")"
}

println("Result:")
for step in steps { println("  " + written(step)) }
println("Expected: (-1 -4 +3 +5 -2) (+1 -4 +3 +5 -2) (+1 +2 -5 -3 +4)")
println("          (+1 +2 +3 +5 +4) (+1 +2 +3 -4 -5) (+1 +2 +3 +4 -5) (+1 +2 +3 +4 +5)")

fn test_ba6a_greedy_sorting() {
    let expected = ["(-1 -4 +3 +5 -2)", "(+1 -4 +3 +5 -2)", "(+1 +2 -5 -3 +4)",
                    "(+1 +2 +3 +5 +4)", "(+1 +2 +3 -4 -5)", "(+1 +2 +3 +4 -5)",
                    "(+1 +2 +3 +4 +5)"]
    assert (steps |> map(|s| written(s))) == expected,
        "BA6A: got " + join(steps |> map(|s| written(s)), " ")
    # It really ends at the identity, and takes at most 2n reversals.
    assert steps[len(steps) - 1] == range(1, len(start) + 1), "BA6A: must end sorted"
    assert len(steps) <= 2 * len(start), "BA6A: greedy sorting is bounded by 2n reversals"
    # Every step is a genuine reversal of the one before: same values, ignoring
    # sign and order.
    let running = start
    for step in steps {
        assert sort(step |> map(|v| abs(v))) == sort(running |> map(|v| abs(v))),
            "BA6A: a reversal cannot change which values are present"
        running = step
    }
}

BA6B — Compute the Number of Breakpoints in a Permutation

solvedbrowser + CLI Problem statement Open in the workbench Download .bl

One reversal removes at most two breakpoints, so half the count is a lower bound on reversal distance — BA6A gives the upper one. A fully reversed permutation is not the worst case: (-5 -4 -3 -2 -1) still steps by one, so it has only two breakpoints and one reversal sorts it.

# Rosalind: BA6B — Compute the Number of Breakpoints in a Permutation
# https://rosalind.info/problems/ba6b/
#
# Given: A signed permutation P.
# Return: The number of breakpoints in P.

let permutation = [3, 4, 5, -12, -8, -7, -6, 1, 2, 10, 9, -11, 13, 14]

# A breakpoint is any adjacent pair that is not consecutive — anywhere the
# permutation is already in order, no reversal need ever touch. Since one
# reversal can remove at most two breakpoints, the breakpoint count divided by
# two is a lower bound on the true reversal distance, which is what makes this
# worth computing at all: BA6A gives an upper bound, this gives a lower one.
#
# The permutation is bracketed by 0 and n+1 so the ends count too — a chromosome
# whose first gene is not gene 1 has a breakpoint there.
let extended = [0] + permutation + [len(permutation) + 1]

let breakpoints = range(1, len(extended))
    |> count_if(|i| extended[i] - extended[i - 1] != 1)

println("Result:   " + str(breakpoints))
println("Expected: 8")

fn test_ba6b_breakpoints() {
    assert breakpoints == 8, "BA6B: got " + str(breakpoints)
    # The identity permutation has none, which is the only permutation that does.
    let identity = [0] + range(1, 6) + [6]
    assert (range(1, len(identity)) |> count_if(|i| identity[i] - identity[i - 1] != 1)) == 0,
        "BA6B: the identity has no breakpoints"
    # Worth being careful here: a *fully reversed* permutation is not the worst
    # case. (-5 -4 -3 -2 -1) still steps by one at every position, so it has only
    # the two breakpoints at its ends — and one reversal sorts it, which the
    # bound below then predicts exactly.
    let flipped = [0, -5, -4, -3, -2, -1, 6]
    assert (range(1, len(flipped)) |> count_if(|i| flipped[i] - flipped[i - 1] != 1)) == 2,
        "BA6B: a full reversal leaves only the two end breakpoints"
    # Interleaving is what actually breaks every adjacency.
    let shuffled = [0, 2, 4, 1, 3, 5]
    assert (range(1, len(shuffled)) |> count_if(|i| shuffled[i] - shuffled[i - 1] != 1)) == 5,
        "BA6B: interleaving breaks every one of the five adjacencies"
    # The lower bound this implies on reversal distance.
    assert breakpoints / 2 == 4, "BA6B: at least 4 reversals are needed"
}

BA6C — Compute the 2-Break Distance Between a Pair of Genomes

solvedbrowser + CLI Problem statement Open in the workbench Download .bl

Blocks minus cycles — a closed form, which is unusual for a rearrangement distance and the reason 2-breaks are studied. A 2-break raises the cycle count by at most one, so the bound is both necessary and achievable.

# Rosalind: BA6C — Compute the 2-Break Distance Between a Pair of Genomes
# https://rosalind.info/problems/ba6c/
#
# Given: Two genomes with circular chromosomes on the same synteny blocks.
# Return: The 2-break distance between them.

let genome_p = [[1, 2, 3, 4, 5, 6]]
let genome_q = [[1, -3, -6, -5], [2, -4]]

# There is a closed form, which is unusual for a rearrangement distance and is
# the reason 2-breaks are studied at all: the distance is the number of synteny
# blocks minus the number of cycles in the two genomes' graphs superimposed.
#
# Superimposing them, every node has one edge from each genome, so the graph
# splits into alternating cycles. A 2-break can increase the cycle count by at
# most one, and the genomes are identical exactly when every cycle is trivial —
# so blocks minus cycles is both a lower bound and achievable.
fn coloured_edges(genome) {
    genome |> flat_map(|chromosome| {
        let nodes = chromosome |> flat_map(|block|
            if block > 0 then [2 * block - 1, 2 * block] else [0 - 2 * block, 0 - 2 * block - 1])
        range(1, len(chromosome) + 1) |> map(|j| {
            let to_index = if 2 * j == len(nodes) then 0 else 2 * j
            { a: nodes[2 * j - 1], b: nodes[to_index] }
        })
    })
}

let edges_p = coloured_edges(genome_p)
let edges_q = coloured_edges(genome_q)
let blocks = genome_p |> map(|c| len(c)) |> sum()

# Adjacency over both edge sets at once.
let links = {}
for edge in edges_p + edges_q {
    for pair in [{ x: edge.a, y: edge.b }, { x: edge.b, y: edge.a }] {
        if contains(keys(links), str(pair.x)) {
            links[str(pair.x)] = push(links[str(pair.x)], pair.y)
        } else {
            links[str(pair.x)] = [pair.y]
        }
    }
}

let seen = {}
let cycles = 0
for node in keys(links) {
    if contains(keys(seen), node) == false {
        cycles = cycles + 1
        let frontier = [node]
        while len(frontier) > 0 {
            let at = frontier[0]
            frontier = slice(frontier, 1, len(frontier))
            if contains(keys(seen), at) == false {
                seen[at] = true
                for neighbour in links[at] {
                    if contains(keys(seen), str(neighbour)) == false {
                        frontier = push(frontier, str(neighbour))
                    }
                }
            }
        }
    }
}

let distance = blocks - cycles

println("Result:   " + str(distance))
println("Expected: 3")
println("(" + str(blocks) + " blocks minus " + str(cycles) + " cycles)")

fn test_ba6c_two_break_distance() {
    assert distance == 3, "BA6C: got " + str(distance)
    assert blocks == 6, "BA6C: six synteny blocks"
    assert cycles == 3, "BA6C: the superimposed graph has three cycles"
    # A genome against itself is distance zero, which is the identity the formula
    # has to satisfy: every cycle is trivial, so cycles equal blocks.
    let self_links = {}
    for edge in edges_p + edges_p {
        for pair in [{ x: edge.a, y: edge.b }, { x: edge.b, y: edge.a }] {
            if contains(keys(self_links), str(pair.x)) {
                self_links[str(pair.x)] = push(self_links[str(pair.x)], pair.y)
            } else {
                self_links[str(pair.x)] = [pair.y]
            }
        }
    }
    let self_seen = {}
    let self_cycles = 0
    for node in keys(self_links) {
        if contains(keys(self_seen), node) == false {
            self_cycles = self_cycles + 1
            let frontier = [node]
            while len(frontier) > 0 {
                let at = frontier[0]
                frontier = slice(frontier, 1, len(frontier))
                if contains(keys(self_seen), at) == false {
                    self_seen[at] = true
                    for neighbour in self_links[at] {
                        if contains(keys(self_seen), str(neighbour)) == false {
                            frontier = push(frontier, str(neighbour))
                        }
                    }
                }
            }
        }
    }
    assert blocks - self_cycles == 0, "BA6C: a genome is distance 0 from itself"
}

BA6D — Find a Shortest Transformation of One Genome into Another by 2-Breaks

solvedbrowser + CLI Problem statement Open in the workbench Download .bl

The constructive half of BA6C's argument: exhibits a path of exactly that length. Finds a different valid path from the published one, so it asserts the endpoints and the step count rather than the listing.

# Rosalind: BA6D — Find a Shortest Transformation of One Genome into Another by 2-Breaks
# https://rosalind.info/problems/ba6d/
#
# Given: Two genomes with circular chromosomes on the same synteny blocks.
# Return: The sequence of genomes along a shortest 2-break transformation.

let genome_p = [[1, -2, -3, 4]]
let genome_q = [[1, 2, -4, -3]]

# BA6C says the distance is blocks minus cycles. This exhibits a path of that
# length, which is the constructive half of the same argument: pick any cycle of
# the combined graph that is not already trivial, and there is always a 2-break
# on P's edges that merges P one step closer to Q while raising the cycle count
# by one. Repeating that reaches Q in exactly blocks-minus-cycles moves.
fn coloured_edges(g) {
    g |> flat_map(|chromosome| {
        let nodes = chromosome |> flat_map(|block|
            if block > 0 then [2 * block - 1, 2 * block] else [0 - 2 * block, 0 - 2 * block - 1])
        range(1, len(chromosome) + 1) |> map(|j| {
            let to_index = if 2 * j == len(nodes) then 0 else 2 * j
            { a: nodes[2 * j - 1], b: nodes[to_index] }
        })
    })
}

fn same_edge(edge, x, y) {
    (edge.a == x and edge.b == y) or (edge.a == y and edge.b == x)
}

fn graph_to_genome(edge_list) {
    let links = {}
    for edge in edge_list {
        links[str(edge.a)] = edge.b
        links[str(edge.b)] = edge.a
    }
    let visited = {}
    let genome = []
    for edge in edge_list {
        if contains(keys(visited), str(edge.a)) == false {
            let cycle = []
            let node = edge.a
            let walking = true
            while walking {
                visited[str(node)] = true
                let partner = links[str(node)]
                visited[str(partner)] = true
                cycle = push(cycle, partner)
                let next_node = if partner % 2 == 1 then partner + 1 else partner - 1
                if contains(keys(visited), str(next_node)) {
                    walking = false
                } else {
                    node = next_node
                }
            }
            let blocks = cycle |> map(|tail|
                if tail % 2 == 1 then (tail + 1) / 2 else 0 - tail / 2)
            let lowest = blocks |> map(|b| abs(b)) |> min()
            let at = (range(0, len(blocks)) |> filter(|i| abs(blocks[i]) == lowest))[0]
            genome = push(genome, range(0, len(blocks)) |> map(|i| blocks[(i + at) % len(blocks)]))
        }
    }
    genome
}

fn written(g) {
    g |> map(|c| "(" + (c |> map(|v| if v > 0 then "+" + str(v) else str(v)) |> join(" ")) + ")")
      |> join("")
}

let red = coloured_edges(genome_p)
let blue = coloured_edges(genome_q)
let steps = [written(graph_to_genome(red))]

# Each round: find a blue edge whose endpoints are joined differently in red, and
# rewire red to match it.
let working = red
let rounds = 0
while rounds < 20 {
    rounds = rounds + 1
    let wrong = blue |> filter(|b| (working |> count_if(|r| same_edge(r, b.a, b.b))) == 0)
    if len(wrong) == 0 { rounds = 100 }
    if rounds < 100 {
        let target = wrong[0]
        # The two red edges currently holding target's endpoints.
        let holding_a = (working |> filter(|r| r.a == target.a or r.b == target.a))[0]
        let holding_b = (working |> filter(|r| r.a == target.b or r.b == target.b))[0]
        let other_a = if holding_a.a == target.a then holding_a.b else holding_a.a
        let other_b = if holding_b.a == target.b then holding_b.b else holding_b.a

        working = (working |> filter(|r|
            same_edge(r, holding_a.a, holding_a.b) == false
            and same_edge(r, holding_b.a, holding_b.b) == false))
            + [{ a: target.a, b: target.b }, { a: other_a, b: other_b }]
        steps = push(steps, written(graph_to_genome(working)))
    }
}

println("Result:")
for step in steps { println("  " + step) }
println("Expected: (+1 -2 -3 +4) / (+1 -2 -3)(+4) / (+1 -2 -4 -3) / (+1 +2 -4 -3)")

fn test_ba6d_two_break_sorting() {
    # The path has to start at P, end at Q, and take exactly the 2-break distance
    # in steps — which is the whole claim being demonstrated.
    assert steps[0] == written(genome_p), "BA6D: must start at P, got " + steps[0]
    let arrived = graph_to_genome(working)
    let magnitudes = sort(arrived |> flat_map(|c| c |> map(|b| abs(b))))
    assert magnitudes == [1, 2, 3, 4], "BA6D: every block must survive"
    # Q reached, compared up to rotation and direction as in BA6K.
    let rotations = |chromosome| range(0, len(chromosome))
        |> map(|shift| join(range(0, len(chromosome))
            |> map(|i| str(chromosome[(i + shift) % len(chromosome)])), " "))
    let flip = |chromosome| reverse(chromosome) |> map(|b| 0 - b)
    let canonical = |chromosome| min(rotations(chromosome) + rotations(flip(chromosome)))
    assert sort(arrived |> map(|c| canonical(c))) == sort(genome_q |> map(|c| canonical(c))),
        "BA6D: the path ends at " + written(arrived) + ", not at Q"
    # Three 2-breaks, so four genomes listed — matching BA6C's formula.
    assert len(steps) == 4, "BA6D: expected 4 genomes, got " + str(len(steps))
}

BA6E — Find All Shared k-mers of a Pair of Strings

solvedbrowser + CLI Problem statement Open in the workbench Download .bl

Reverse complements count because an inversion puts a conserved block on the other strand; ignoring that would make every inverted block look like a deletion. Plotting the pairs gives the dot plot rearrangements are read off.

# Rosalind: BA6E — Find All Shared k-mers of a Pair of Strings
# https://rosalind.info/problems/ba6e/
#
# Given: An integer k and two strings.
# Return: Every pair of positions (x, y) where the strings share a k-mer, taking
# reverse complements into account.

let k = 3
let first_text = "AAACTCATC"
let second_text = "TTTCAAATC"

# The reverse complement counts because a synteny block conserved between two
# genomes may sit on either strand — an inversion flips a segment, and the same
# genes then read backwards. Ignoring that would make every inverted block look
# like a deletion.
#
# Plotting these pairs gives the dot plot from which rearrangements are read off:
# diagonal runs are conserved blocks, and anti-diagonal runs are inverted ones.
let shared = range(0, len(first_text) - k + 1) |> flat_map(|x| {
    let piece = substr(first_text, x, k)
    let flipped = str(reverse_complement(dna(piece)))
    range(0, len(second_text) - k + 1)
        |> filter(|y| {
            let other = substr(second_text, y, k)
            other == piece or other == flipped
        })
        |> map(|y| { x: x, y: y })
})

println("Result:   " + (shared |> map(|p| "(" + str(p.x) + ", " + str(p.y) + ")") |> join(" ")))
println("Expected: (0, 4) (0, 0) (4, 2) (6, 6)   (in any order)")

fn test_ba6e_shared_kmers() {
    let written = sort(shared |> map(|p| "(" + str(p.x) + ", " + str(p.y) + ")"))
    assert written == sort(["(0, 4)", "(0, 0)", "(4, 2)", "(6, 6)"]),
        "BA6E: got " + join(written, " ")
    # Every pair really shares a k-mer, one way round or the other.
    for pair in shared {
        let piece = substr(first_text, pair.x, k)
        let other = substr(second_text, pair.y, k)
        assert other == piece or other == str(reverse_complement(dna(piece))),
            "BA6E: " + piece + " and " + other + " are not a shared k-mer"
    }
    # (0, 4) is the reverse-complement match — AAA against TTT — which a
    # same-strand search would miss entirely.
    assert substr(first_text, 0, k) == "AAA" and substr(second_text, 4, k) == "AAA",
        "BA6E: position 4 of the second string is a direct match"
    assert substr(second_text, 0, k) == "TTT", "BA6E: and position 0 is its reverse complement"
}

BA6F — Implement ChromosomeToCycle

solvedbrowser + CLI Problem statement Open in the workbench Download .bl

Every block becomes a head and a tail, so orientation stops being a sign and becomes a direction of travel — the representation 2-breaks are defined on.

# Rosalind: BA6F — Implement ChromosomeToCycle
# https://rosalind.info/problems/ba6f/
#
# Given: A chromosome of n synteny blocks.
# Return: The 2n node numbers ChromosomeToCycle produces.

let chromosome = [1, -2, -3, 4]

# Every block becomes two nodes, its head and its tail, so orientation stops
# being a sign and becomes a direction of travel. That is the representation
#2-breaks are defined on: a rearrangement cuts two edges and reconnects the four
# loose ends, which is easy to say about nodes and awkward to say about signed
# integers.
let cycle_nodes = chromosome |> flat_map(|block|
    if block > 0 then [2 * block - 1, 2 * block] else [0 - 2 * block, 0 - 2 * block - 1])

println("Result:   (" + (cycle_nodes |> map(|n| str(n)) |> join(" ")) + ")")
println("Expected: (1 2 4 3 6 5 7 8)")

fn test_ba6f_chromosome_to_cycle() {
    assert cycle_nodes == [1, 2, 4, 3, 6, 5, 7, 8], "BA6F: got " + str(cycle_nodes)
    # Two nodes per block, and every number from 1 to 2n used exactly once.
    assert len(cycle_nodes) == 2 * len(chromosome), "BA6F: two cycle_nodes per block"
    assert sort(cycle_nodes) == range(1, 2 * len(chromosome) + 1),
        "BA6F: the cycle_nodes must be 1..2n, each once"
    # A positive block reads head-then-tail; a negative one reads the other way,
    # which is the whole encoding.
    assert cycle_nodes[0] < cycle_nodes[1], "BA6F: +1 runs forwards"
    assert cycle_nodes[2] > cycle_nodes[3], "BA6F: -2 runs backwards"
}

BA6G — Implement CycleToChromosome

solvedbrowser + CLI Problem statement Open in the workbench Download .bl

The inverse of BA6F, asserted by round-tripping rather than only by matching the sample. The sign is recovered from the order of each node pair rather than stored.

# Rosalind: BA6G — Implement CycleToChromosome
# https://rosalind.info/problems/ba6g/
#
# Given: A sequence of 2n node numbers.
# Return: The chromosome whose cycle they are.

let cycle_nodes = [1, 2, 4, 3, 6, 5, 7, 8]

# The inverse of BA6F. Each pair of nodes is one block, and which of the two
# comes first says which way it reads — so the sign is recovered from the order
# rather than stored.
let chromosome = range(0, len(cycle_nodes) / 2) |> map(|j| {
    let head = cycle_nodes[2 * j]
    let tail = cycle_nodes[2 * j + 1]
    if head < tail then tail / 2 else 0 - head / 2
})

fn written(items) {
    "(" + (items |> map(|v| if v > 0 then "+" + str(v) else str(v)) |> join(" ")) + ")"
}

println("Result:   " + written(chromosome))
println("Expected: (+1 -2 -3 +4)")

fn test_ba6g_cycle_to_chromosome() {
    assert written(chromosome) == "(+1 -2 -3 +4)", "BA6G: got " + written(chromosome)
    # It really inverts BA6F: converting back gives the nodes it started from.
    let round_trip = chromosome |> flat_map(|block|
        if block > 0 then [2 * block - 1, 2 * block] else [0 - 2 * block, 0 - 2 * block - 1])
    assert round_trip == cycle_nodes, "BA6G: the round trip does not return the cycle_nodes"
    assert len(chromosome) == len(cycle_nodes) / 2, "BA6G: one block per pair of cycle_nodes"
}

BA6H — Implement ColoredEdges

solvedbrowser + CLI Problem statement Open in the workbench Download .bl

Only the edges between blocks are kept — the adjacencies a rearrangement can break. Every node carries exactly one, which is what makes the graph a set of disjoint cycles and BA6C computable.

# Rosalind: BA6H — Implement ColoredEdges
# https://rosalind.info/problems/ba6h/
#
# Given: A genome P.
# Return: The coloured edges of its genome graph.

let chromosomes = [[1, -2, -3], [4, 5, -6]]

# Coloured edges are the ones joining *different* blocks — the adjacencies a
# rearrangement can break. The edges inside a block are fixed, so they carry no
# information and are left out; what remains is exactly the structure two genomes
# can be compared on.
fn chromosome_to_cycle(chromosome) {
    chromosome |> flat_map(|block|
        if block > 0 then [2 * block - 1, 2 * block] else [0 - 2 * block, 0 - 2 * block - 1])
}

let edges_list = chromosomes |> flat_map(|chromosome| {
    let nodes = chromosome_to_cycle(chromosome)
    # The last edge wraps round, because a chromosome here is circular.
    range(1, len(chromosome) + 1) |> map(|j| {
        let to_index = if 2 * j == len(nodes) then 0 else 2 * j
        { a: nodes[2 * j - 1], b: nodes[to_index] }
    })
})

println("Result:   " + (edges_list |> map(|e| "(" + str(e.a) + ", " + str(e.b) + ")") |> join(", ")))
println("Expected: (2, 4), (3, 6), (5, 1), (8, 9), (10, 12), (11, 7)")

fn test_ba6h_coloured_edges() {
    let written = edges_list |> map(|e| "(" + str(e.a) + ", " + str(e.b) + ")") |> join(", ")
    assert written == "(2, 4), (3, 6), (5, 1), (8, 9), (10, 12), (11, 7)",
        "BA6H: got " + written
    # One coloured edge per block, since each block has one outgoing adjacency.
    let block_count = chromosomes |> map(|c| len(c)) |> sum()
    assert len(edges_list) == block_count, "BA6H: one coloured edge per block"
    # Every node appears in at most one coloured edge on each side — the graph is
    # a set of disjoint cycles, which is what makes 2-break distance computable.
    let touched = edges_list |> flat_map(|e| [e.a, e.b])
    assert len(unique(touched)) == len(touched), "BA6H: a node cannot have two coloured edges"
}

BA6I — Implement GraphToGenome

solvedbrowser + CLI Problem statement Open in the workbench Download .bl

A circular chromosome has no distinguished starting block, so the walk produced (-2 -3 +1) where the sample shows (+1 -2 -3) — the same chromosome. Rotated to the lowest-numbered block for a stable listing, with the rotation-invariance asserted rather than hidden.

# Rosalind: BA6I — Implement GraphToGenome
# https://rosalind.info/problems/ba6i/
#
# Given: The coloured edges of a genome graph.
# Return: The genome.

let coloured = [
    { a: 2, b: 4 }, { a: 3, b: 6 }, { a: 5, b: 1 },
    { a: 7, b: 9 }, { a: 10, b: 12 }, { a: 11, b: 8 },
]

# The inverse of BA6H, and the step that makes 2-breaks usable: a 2-break is
# easy to apply to a set of edges and meaningless as an operation on signed
# integers, so genomes are converted to a graph, rearranged, and converted back.
#
# The edges form disjoint cycles; each cycle is one chromosome. Walking a cycle
# means alternating between the coloured edges given here and the implicit
# black edges inside each block, which is why the walk steps by one node between
# coloured edges.
let neighbours = {}
for edge in coloured {
    neighbours[str(edge.a)] = edge.b
    neighbours[str(edge.b)] = edge.a
}

let visited = {}
let chromosomes = []
for edge in coloured {
    if contains(keys(visited), str(edge.a)) == false {
        # Walk the cycle this edge belongs to, collecting node pairs.
        let cycle = []
        let node = edge.a
        let walking = true
        while walking {
            visited[str(node)] = true
            let partner = neighbours[str(node)]
            visited[str(partner)] = true
            cycle = push(cycle, { head: node, tail: partner })
            # The black edge: from `partner` to the other node of its block.
            let next_node = if partner % 2 == 1 then partner + 1 else partner - 1
            if contains(keys(visited), str(next_node)) { walking = false } else { node = next_node }
        }

        # Each collected pair (tail of one block, head of the next) becomes a
        # block once shifted round by one.
        let blocks = cycle |> map(|pair|
            if pair.tail % 2 == 1 then (pair.tail + 1) / 2 else 0 - pair.tail / 2)

        # A circular chromosome has no distinguished starting block, so the walk
        # can begin anywhere and every rotation is the same chromosome. Rotated
        # here to start at the lowest-numbered block, which is what makes the
        # output comparable to the published one.
        let lowest = blocks |> map(|b| abs(b)) |> min()
        let at = (range(0, len(blocks)) |> filter(|i| abs(blocks[i]) == lowest))[0]
        let rotated = range(0, len(blocks)) |> map(|i| blocks[(i + at) % len(blocks)])
        chromosomes = push(chromosomes, rotated)
    }
}

fn written(items) {
    "(" + (items |> map(|v| if v > 0 then "+" + str(v) else str(v)) |> join(" ")) + ")"
}

let shown = chromosomes |> map(|c| written(c)) |> join("")

println("Result:   " + shown)
println("Expected: (+1 -2 -3)(-4 +5 -6)")

fn test_ba6i_graph_to_genome() {
    assert shown == "(+1 -2 -3)(-4 +5 -6)", "BA6I: got " + shown
    assert len(chromosomes) == 2, "BA6I: the edges form two cycles, so two chromosomes"
    # Rotation-invariance is a real property, not a formatting detail: the walk
    # produced (-2 -3 +1) before rotating, which is the same circular chromosome.
    let first_chromosome = chromosomes[0]
    let rotated_once = range(0, len(first_chromosome))
        |> map(|i| first_chromosome[(i + 1) % len(first_chromosome)])
    assert rotated_once != first_chromosome, "BA6I: a rotation is a different listing"
    assert sort(rotated_once) == sort(first_chromosome), "BA6I: but the same chromosome"
    # Every block from 1 to 6 appears exactly once, either way up.
    let magnitudes = sort(chromosomes |> flat_map(|c| c |> map(|b| abs(b))))
    assert magnitudes == range(1, 7), "BA6I: every block must appear once"
}

BA6J — Implement 2-BreakOnGenomeGraph

solvedbrowser + CLI Problem statement Open in the workbench Download .bl

The single operation every rearrangement reduces to: cut two adjacencies, rejoin the four ends the other way. Reversals, translocations, fusions and fissions are all this one move.

# Rosalind: BA6J — Implement 2-BreakOnGenomeGraph
# https://rosalind.info/problems/ba6j/
#
# Given: A genome graph and four nodes i, i', j, j'.
# Return: The graph after removing edges (i, i') and (j, j') and adding (i, j)
# and (i', j').

let edge_set = [
    { a: 2, b: 4 }, { a: 3, b: 8 }, { a: 7, b: 5 }, { a: 6, b: 1 },
]
let breakpoint = { i: 1, i_end: 6, j: 3, j_end: 8 }

# A 2-break is the single operation every rearrangement reduces to: cut two
# adjacencies and rejoin the four loose ends the other way. Reversals,
# translocations, fusions and fissions are all this one move — which is exactly
# why BA6C can put a closed form on the distance.
fn same_edge(edge, x, y) {
    (edge.a == x and edge.b == y) or (edge.a == y and edge.b == x)
}

let kept = edge_set |> filter(|edge|
    same_edge(edge, breakpoint.i, breakpoint.i_end) == false and same_edge(edge, breakpoint.j, breakpoint.j_end) == false)

let rejoined = kept + [{ a: breakpoint.j, b: breakpoint.i }, { a: breakpoint.i_end, b: breakpoint.j_end }]

fn written(edges_list) {
    edges_list |> map(|e| "(" + str(e.a) + ", " + str(e.b) + ")") |> join(", ")
}

println("Result:   " + written(rejoined))
println("Expected: (2, 4), (3, 1), (7, 5), (6, 8)   (in any order)")

fn test_ba6j_two_break_on_graph() {
    # The two edges that were cut are gone, the two new ones are present, and
    # everything else is untouched. Order is not meaningful in an edge set.
    assert len(rejoined) == len(edge_set), "BA6J: a 2-break preserves the edge count"
    assert (rejoined |> count_if(|e| same_edge(e, 1, 6))) == 0, "BA6J: (1, 6) should be gone"
    assert (rejoined |> count_if(|e| same_edge(e, 3, 8))) == 0, "BA6J: (3, 8) should be gone"
    assert (rejoined |> count_if(|e| same_edge(e, 3, 1))) == 1, "BA6J: (3, 1) should be present"
    assert (rejoined |> count_if(|e| same_edge(e, 6, 8))) == 1, "BA6J: (6, 8) should be present"
    assert (rejoined |> count_if(|e| same_edge(e, 2, 4))) == 1, "BA6J: (2, 4) is untouched"
    assert (rejoined |> count_if(|e| same_edge(e, 7, 5))) == 1, "BA6J: (7, 5) is untouched"
    # Every node still has exactly one coloured edge, which is what keeps the
    # graph a set of disjoint cycles.
    let touched = rejoined |> flat_map(|e| [e.a, e.b])
    assert len(unique(touched)) == len(touched), "BA6J: a node cannot gain a second edge"
}

BA6K — Implement 2-BreakOnGenome

solvedbrowser + CLI Problem statement Open in the workbench Download .bl

BA6H, BA6J and BA6I assembled. This particular break is a fission. The result reads each chromosome in the opposite direction from the published answer, so the assertion canonicalises over rotation and reflection — a circular chromosome read backwards flips every sign and is still the same chromosome.

# Rosalind: BA6K — Implement 2-BreakOnGenome
# https://rosalind.info/problems/ba6k/
#
# Given: A genome P and four nodes i, i', j, j'.
# Return: The genome after the 2-break.

let chromosomes = [[1, -2, -4, 3]]
let breakpoint = { i: 1, i_end: 6, j: 3, j_end: 8 }

# The three previous problems assembled. A 2-break is meaningless applied to
# signed integers directly, so the genome is converted to a graph (BA6H), the
# break applied there (BA6J), and the result converted back (BA6I). Here it
# splits one chromosome into two, which is a fission — and the same operation
# with different arguments would fuse, invert or translocate.
fn coloured_edges(g) {
    g |> flat_map(|chromosome| {
        let nodes = chromosome |> flat_map(|block|
            if block > 0 then [2 * block - 1, 2 * block] else [0 - 2 * block, 0 - 2 * block - 1])
        range(1, len(chromosome) + 1) |> map(|j| {
            let to_index = if 2 * j == len(nodes) then 0 else 2 * j
            { a: nodes[2 * j - 1], b: nodes[to_index] }
        })
    })
}

fn same_edge(edge, x, y) {
    (edge.a == x and edge.b == y) or (edge.a == y and edge.b == x)
}

let broken = (coloured_edges(chromosomes) |> filter(|edge|
    same_edge(edge, breakpoint.i, breakpoint.i_end) == false and same_edge(edge, breakpoint.j, breakpoint.j_end) == false))
    + [{ a: breakpoint.i, b: breakpoint.j }, { a: breakpoint.i_end, b: breakpoint.j_end }]

# Back to a genome, exactly as in BA6I.
let links = {}
for edge in broken {
    links[str(edge.a)] = edge.b
    links[str(edge.b)] = edge.a
}

let visited = {}
let rebuilt = []
for edge in broken {
    if contains(keys(visited), str(edge.a)) == false {
        let cycle = []
        let node = edge.a
        let walking = true
        while walking {
            visited[str(node)] = true
            let partner = links[str(node)]
            visited[str(partner)] = true
            cycle = push(cycle, partner)
            let next_node = if partner % 2 == 1 then partner + 1 else partner - 1
            if contains(keys(visited), str(next_node)) { walking = false } else { node = next_node }
        }
        let blocks = cycle |> map(|tail|
            if tail % 2 == 1 then (tail + 1) / 2 else 0 - tail / 2)
        # Circular, so rotate to the lowest-numbered block for a stable listing.
        let lowest = blocks |> map(|b| abs(b)) |> min()
        let at = (range(0, len(blocks)) |> filter(|i| abs(blocks[i]) == lowest))[0]
        rebuilt = push(rebuilt, range(0, len(blocks)) |> map(|i| blocks[(i + at) % len(blocks)]))
    }
}

fn written(items) {
    "(" + (items |> map(|v| if v > 0 then "+" + str(v) else str(v)) |> join(" ")) + ")"
}

let shown = rebuilt |> map(|c| written(c)) |> join(" ")

println("Result:   " + shown)
println("Expected: (+2 -1) (-3 +4)   (up to rotation and which chromosome is listed first)")

fn test_ba6k_two_break_on_genome() {
    # One chromosome became two: this 2-break is a fission.
    assert len(rebuilt) == 2, "BA6K: expected a fission into two chromosomes"
    # Every block survives exactly once, either way up — a 2-break rearranges,
    # it never creates or destroys.
    let magnitudes = sort(rebuilt |> flat_map(|c| c |> map(|b| abs(b))))
    assert magnitudes == [1, 2, 3, 4], "BA6K: every block must survive exactly once"
    # A circular chromosome is the same chromosome under rotation *and* under
    # reading it the other way round, which flips every sign as well as the
    # order. This run produced (+1 -2) where the sample shows (+2 -1) — the same
    # chromosome traversed in the opposite direction. Canonicalising over both
    # symmetries is what makes the comparison meaningful.
    let rotations = |chromosome| range(0, len(chromosome))
        |> map(|shift| join(range(0, len(chromosome))
            |> map(|i| str(chromosome[(i + shift) % len(chromosome)])), " "))
    let flip = |chromosome| reverse(chromosome) |> map(|b| 0 - b)
    let canonical = |chromosome| min(rotations(chromosome) + rotations(flip(chromosome)))

    let mine = sort(rebuilt |> map(|c| canonical(c)))
    let published = sort([canonical([2, -1]), canonical([-3, 4])])
    assert mine == published,
        "BA6K: got " + join(mine, " / ") + " against " + join(published, " / ")
    # And the two really are different listings of the same thing.
    assert canonical([1, -2]) == canonical([2, -1]),
        "BA6K: (+1 -2) and (+2 -1) are one circular chromosome"
}

BA11A — Construct the Graph of a Spectrum

solvedbrowser + CLI Problem statement Open in the workbench Download .bl

Reading a peptide off a spectrum rather than guessing peptides and scoring them as BA4 did. Every path from 0 to the heaviest mass spells a candidate, so sequencing becomes a path problem instead of a search over 20^n peptides.

# Rosalind: BA11A — Construct the Graph of a Spectrum
# https://rosalind.info/problems/ba11a/
#
# Given: A spectrum of masses.
# Return: The spectrum graph — an edge between two masses whenever their
# difference is the mass of an amino acid.

let spectrum = [57, 71, 154, 185, 301, 332, 415, 429, 486]

# Reading a peptide off a spectrum, rather than guessing peptides and scoring
# them as BA4 did. Every path from 0 to the largest mass spells a candidate,
# because consecutive prefix masses differ by exactly one residue — so sequencing
# becomes a path problem instead of a search over 20^n peptides.
#
# The graph is a DAG (masses only increase), which is what makes BA11B able to
# read every candidate off it cheaply.
let mass_table = [
    { letter: "G", mass: 57 },  { letter: "A", mass: 71 },  { letter: "S", mass: 87 },
    { letter: "P", mass: 97 },  { letter: "V", mass: 99 },  { letter: "T", mass: 101 },
    { letter: "C", mass: 103 }, { letter: "I", mass: 113 }, { letter: "L", mass: 113 },
    { letter: "N", mass: 114 }, { letter: "D", mass: 115 }, { letter: "K", mass: 128 },
    { letter: "Q", mass: 128 }, { letter: "E", mass: 129 }, { letter: "M", mass: 131 },
    { letter: "H", mass: 137 }, { letter: "F", mass: 147 }, { letter: "R", mass: 156 },
    { letter: "Y", mass: 163 }, { letter: "W", mass: 186 },
]

# Rosalind's answer names one letter per mass, taking the first of each
# colliding pair — I before L, K before Q.
let canonical = {}
for entry in mass_table {
    if contains(keys(canonical), str(entry.mass)) == false {
        canonical[str(entry.mass)] = entry.letter
    }
}

let with_zero = [0] + spectrum
let arcs = with_zero |> flat_map(|from_mass|
    with_zero
        |> filter(|to_mass| to_mass > from_mass
                  and contains(keys(canonical), str(to_mass - from_mass)))
        |> map(|to_mass| str(from_mass) + "->" + str(to_mass) + ":"
                         + canonical[str(to_mass - from_mass)]))

println("Result:")
for line in arcs { println("  " + line) }
println("Expected: 0->57:G 0->71:A 57->154:P 57->185:K 71->185:N 154->301:F")
println("          185->332:F 301->415:N 301->429:K 332->429:P 415->486:A 429->486:G")

fn test_ba11a_spectrum_graph() {
    let expected = ["0->57:G", "0->71:A", "57->154:P", "57->185:K", "71->185:N",
                    "154->301:F", "185->332:F", "301->415:N", "301->429:K",
                    "332->429:P", "415->486:A", "429->486:G"]
    assert sort(arcs) == sort(expected), "BA11A: got " + join(sort(arcs), " ")
    # Every edge's label really weighs the difference it spans.
    for line in arcs {
        let parts = split(line, "->")
        let ends = split(parts[1], ":")
        let gap = int(ends[0]) - int(parts[0])
        assert canonical[str(gap)] == ends[1], "BA11A: " + line + " is mislabelled"
    }
    # Masses only increase, so the graph is acyclic — which is what lets BA11B
    # enumerate its paths.
    for line in arcs {
        let parts = split(line, "->")
        assert int(split(parts[1], ":")[0]) > int(parts[0]), "BA11A: an edge goes backwards"
    }
}

BA11B — Implement DecodingIdealSpectrum

solvedbrowser + CLI Problem statement Open in the workbench Download .bl

A spectrum holds prefix and suffix masses mixed together, so not every path is an answer — each candidate is rebuilt and checked. GPFNA and its reverse ANFPG both survive, because reversing a peptide only swaps which masses are prefixes.

# Rosalind: BA11B — Implement DecodingIdealSpectrum
# https://rosalind.info/problems/ba11b/
#
# Given: An ideal spectrum.
# Return: A peptide whose ideal spectrum it is.

let spectrum = [57, 71, 154, 185, 301, 332, 415, 429, 486]

let mass_table = [
    { letter: "G", mass: 57 },  { letter: "A", mass: 71 },  { letter: "S", mass: 87 },
    { letter: "P", mass: 97 },  { letter: "V", mass: 99 },  { letter: "T", mass: 101 },
    { letter: "C", mass: 103 }, { letter: "I", mass: 113 }, { letter: "L", mass: 113 },
    { letter: "N", mass: 114 }, { letter: "D", mass: 115 }, { letter: "K", mass: 128 },
    { letter: "Q", mass: 128 }, { letter: "E", mass: 129 }, { letter: "M", mass: 131 },
    { letter: "H", mass: 137 }, { letter: "F", mass: 147 }, { letter: "R", mass: 156 },
    { letter: "Y", mass: 163 }, { letter: "W", mass: 186 },
]
let canonical = {}
for entry in mass_table {
    if contains(keys(canonical), str(entry.mass)) == false {
        canonical[str(entry.mass)] = entry.letter
    }
}

# Every path through BA11A's graph from 0 to the heaviest mass spells a
# candidate, but not every candidate is right: the spectrum holds prefix *and*
# suffix masses mixed together, and a path only accounts for the prefixes. So
# each candidate is generated and then checked by rebuilding its full ideal
# spectrum — generate-and-test, but over a handful of paths rather than 20^n
# peptides.
let masses = [0] + spectrum
let heaviest = max(spectrum)

fn ideal_spectrum_of(peptide, letters) {
    let running = 0
    let prefixes = []
    for residue in chars(peptide) {
        running = running + letters[residue]
        prefixes = push(prefixes, running)
    }
    let total = running
    # Prefixes and suffixes together. The empty piece is dropped, and the whole
    # peptide appears once rather than twice — it is both the last prefix and the
    # last suffix, and the spectrum lists it a single time.
    let proper_prefixes = prefixes |> filter(|m| m != total)
    let proper_suffixes = prefixes |> map(|m| total - m) |> filter(|m| m != 0)
    sort(proper_prefixes + proper_suffixes + [total])
}

let letter_mass = {}
for entry in mass_table { letter_mass[entry.letter] = entry.mass }

# Depth-first over the graph, collecting complete paths.
let candidates = []
let stack = [{ at: 0, spelled: "" }]
while len(stack) > 0 {
    let state = stack[len(stack) - 1]
    stack = slice(stack, 0, len(stack) - 1)
    if state.at == heaviest {
        candidates = push(candidates, state.spelled)
    } else {
        for onward in masses {
            if onward > state.at and contains(keys(canonical), str(onward - state.at)) {
                stack = push(stack, {
                    at: onward,
                    spelled: state.spelled + canonical[str(onward - state.at)],
                })
            }
        }
    }
}

let answers = candidates |> filter(|p| ideal_spectrum_of(p, letter_mass) == sort(spectrum))

println("Candidates from the graph: " + join(candidates, " "))
println("Consistent with the spectrum: " + join(answers, " "))
println("Result:   " + answers[0])
println("Expected: GPFNA — and ANFPG is equally correct, being its reverse:")
println("          an ideal spectrum holds prefixes and suffixes together, and")
println("          reversing a peptide simply swaps which is which.")

fn test_ba11b_decoding_ideal_spectrum() {
    assert contains(answers, "GPFNA"), "BA11B: GPFNA should be among " + join(answers, " ")
    assert ideal_spectrum_of("GPFNA", letter_mass) == sort(spectrum),
        "BA11B: GPFNA's ideal spectrum must be the input"
    # The filtering step is doing real work — the graph offers paths that are not
    # answers, which is why generate-and-test is needed rather than any path.
    assert len(candidates) > len(answers),
        "BA11B: some graph paths should fail the spectrum check"
    # A peptide and its reverse have the same ideal spectrum, so both survive —
    # this is a real ambiguity in the data, not a bug in the search.
    assert contains(answers, "ANFPG"), "BA11B: the reverse should also be consistent"
    assert reverse("GPFNA") == "ANFPG", "BA11B: and it is the reverse"
    assert ideal_spectrum_of("ANFPG", letter_mass) == ideal_spectrum_of("GPFNA", letter_mass),
        "BA11B: a peptide and its reverse share an ideal spectrum"
}

BA11C — Convert a Peptide into a Peptide Vector

solvedbrowser + CLI Problem statement Open in the workbench Download .bl

Puts a peptide in the same shape as a spectrum so the two can be compared by a dot product — which is what makes scoring one multiplication per position and finding the best peptide a path problem.

# Rosalind: BA11C — Convert a Peptide into a Peptide Vector
# https://rosalind.info/problems/ba11c/
#
# Given: A peptide.
# Return: Its peptide vector — a 1 at every prefix mass, 0 elsewhere.

# The toy alphabet Rosalind uses for this chapter: X weighs 4 and Z weighs 5.
# Small masses keep the vectors readable; the real 18-mass table works the same
# way and produces vectors thousands of entries long.
let peptide = "XZZXX"
let toy_masses = { "X": 4, "Z": 5 }

# A peptide vector turns a peptide into something the same shape as a spectrum,
# so the two can be compared by a dot product. That is the whole idea behind the
# chapter: scoring a peptide against a spectrum becomes one multiplication per
# position, and finding the best peptide becomes a path problem over the vector.
let prefix_masses = []
let running = 0
for residue in chars(peptide) {
    running = running + toy_masses[residue]
    prefix_masses = push(prefix_masses, running)
}

let total = running
let vector = range(1, total + 1) |> map(|mass| if contains(prefix_masses, mass) then 1 else 0)

println("Result:   " + (vector |> map(|v| str(v)) |> join(" ")))
println("Expected: 0 0 0 1 0 0 0 0 1 0 0 0 0 1 0 0 0 1 0 0 0 1")

fn test_ba11c_peptide_to_vector() {
    assert (vector |> map(|v| str(v)) |> join(" "))
        == "0 0 0 1 0 0 0 0 1 0 0 0 0 1 0 0 0 1 0 0 0 1",
        "BA11C: got " + join(vector |> map(|v| str(v)), " ")
    # As many 1s as residues, and the last entry is always 1 — the peptide's own
    # mass is its final prefix.
    assert sum(vector) == len(peptide), "BA11C: one 1 per residue"
    assert vector[len(vector) - 1] == 1, "BA11C: the total mass is the last prefix"
    assert len(vector) == total, "BA11C: the vector is as long as the peptide is heavy"
    assert prefix_masses == [4, 9, 14, 18, 22], "BA11C: prefix masses"
}

BA11D — Convert a Peptide Vector into a Peptide

solvedbrowser + CLI Problem statement Open in the workbench Download .bl

The inverse of BA11C: gaps between consecutive 1s are the residue masses, so nothing has to be searched for. Asserted by round-tripping.

# Rosalind: BA11D — Convert a Peptide Vector into a Peptide
# https://rosalind.info/problems/ba11d/
#
# Given: A peptide vector.
# Return: A peptide with that vector.

let vector = [0, 0, 0, 1, 0, 0, 0, 0, 1, 0, 0, 0, 0, 1, 0, 0, 0, 1, 0, 0, 0, 1]
let toy_masses = { "X": 4, "Z": 5 }

# The inverse of BA11C. Each 1 is a prefix mass, so the gaps between consecutive
# 1s are the residue masses — reading them off in order spells the peptide, and
# nothing has to be searched for.
let prefix_positions = range(0, len(vector)) |> filter(|i| vector[i] == 1) |> map(|i| i + 1)
let gaps = range(0, len(prefix_positions)) |> map(|i| if i == 0 then prefix_positions[0] else prefix_positions[i] - prefix_positions[i - 1])

let by_mass = {}
for letter in keys(toy_masses) { by_mass[str(toy_masses[letter])] = letter }

let peptide = gaps |> map(|gap| by_mass[str(gap)]) |> join("")

println("Result:   " + peptide)
println("Expected: XZZXX")

fn test_ba11d_vector_to_peptide() {
    assert peptide == "XZZXX", "BA11D: got " + peptide
    # It really inverts BA11C: rebuilding the vector returns the input.
    let running = 0
    let rebuilt_prefixes = []
    for residue in chars(peptide) {
        running = running + toy_masses[residue]
        rebuilt_prefixes = push(rebuilt_prefixes, running)
    }
    let rebuilt = range(1, running + 1)
        |> map(|mass| if contains(rebuilt_prefixes, mass) then 1 else 0)
    assert rebuilt == vector, "BA11D: the round trip does not return the vector"
    assert len(peptide) == sum(vector), "BA11D: one residue per 1 in the vector"
}

BA11E — Sequence a Peptide

solvedbrowser + CLI Problem statement Open in the workbench Download .bl

The heaviest path through a graph of prefix positions. Negative entries matter — a spectral vector is measurement, not a count, so a path is penalised for claiming a prefix the data argues against, which is what stops the answer being simply the longest path.

# Rosalind: BA11E — Sequence a Peptide
# https://rosalind.info/problems/ba11e/
#
# Given: A spectral vector S.
# Return: A peptide whose peptide vector scores highest against S.

let spectral = [0, 0, 0, 4, -2, -3, -1, -7, 6, 5, 3, 2, 1, 9, 3, -8, 0, 3, 1, 2, 1, 0]
let toy_masses = { "X": 4, "Z": 5 }

# BA11C made peptides and spectra the same shape so they could be compared by a
# dot product. This is why: a peptide's score is the sum of the spectral entries
# at its prefix masses, so the best peptide is the heaviest path through a graph
# whose nodes are positions and whose edges are residues.
#
# Negative entries matter — a spectral vector is real measurement, not a count,
# so a path is penalised for claiming a prefix the data argues against. That is
# what stops the answer being simply the longest path.
let masses = [0] + spectral
let sink = len(spectral)

let best = range(0, sink + 1) |> map(|i| if i == 0 then 0 else 0 - 1000000)
let came_from = {}

for position in range(1, sink + 1) {
    for letter in keys(toy_masses) {
        let previous = position - toy_masses[letter]
        if previous >= 0 and best[previous] > 0 - 1000000 {
            let candidate = best[previous] + spectral[position - 1]
            if candidate > best[position] {
                best[position] = candidate
                came_from[str(position)] = { at: previous, letter: letter }
            }
        }
    }
}

let peptide = ""
let at = sink
while at > 0 {
    let step = came_from[str(at)]
    peptide = step.letter + peptide
    at = step.at
}

println("Result:   " + peptide + "   score " + str(best[sink]))
println("Expected: XZZXX")

fn test_ba11e_peptide_sequencing() {
    assert peptide == "XZZXX", "BA11E: got " + peptide
    # The reported score must be what the peptide actually scores against S.
    let running = 0
    let prefixes = []
    for residue in chars(peptide) {
        running = running + toy_masses[residue]
        prefixes = push(prefixes, running)
    }
    let scored = prefixes |> map(|m| spectral[m - 1]) |> sum()
    assert scored == best[sink],
        "BA11E: the path claims " + str(best[sink]) + " but the peptide scores " + str(scored)
    # The peptide's mass has to be the vector's length — a shorter one is not a
    # candidate at all, however well it scores.
    assert running == len(spectral), "BA11E: the peptide must weigh the whole vector"
    # And it beats an alternative of the same mass.
    let rival = "ZXXZX"
    let rival_running = 0
    let rival_prefixes = []
    for residue in chars(rival) {
        rival_running = rival_running + toy_masses[residue]
        rival_prefixes = push(rival_prefixes, rival_running)
    }
    assert (rival_prefixes |> map(|m| spectral[m - 1]) |> sum()) < scored,
        "BA11E: " + rival + " should score lower"
}

BA11F — Find a Highest-Scoring Peptide in a Proteome against a Spectrum

solvedbrowser + CLI Problem statement Open in the workbench Download .bl

The realistic version of BA11E: only substrings of a known proteome are candidates, which is how proteomics actually works and what makes the search tractable.

# Rosalind: BA11F — Find a Highest-Scoring Peptide in a Proteome against a Spectrum
# https://rosalind.info/problems/ba11f/
#
# Given: A spectral vector S and a proteome.
# Return: The substring of the proteome scoring highest against S.

let spectral = [0, 0, 0, 4, -2, -3, -1, -7, 6, 5, 3, 2, 1, 9, 3, -8, 0, 3, 1, 2, 1, 8]
let proteome = "XZZXZXXXZXZZXZXXZ"
let toy_masses = { "X": 4, "Z": 5 }

# The realistic version of BA11E. There, any peptide the masses allowed was a
# candidate; here only substrings of a known proteome are, which is how
# proteomics actually works — the genome is sequenced first, and the spectrum is
# matched against what it could produce. Constraining the search that way is also
# what makes it tractable.
let total = len(spectral)

fn mass_of(piece, letters) { chars(piece) |> map(|c| letters[c]) |> sum() }

fn score_of(piece, letters, vector) {
    let running = 0
    let prefixes = []
    for residue in chars(piece) {
        running = running + letters[residue]
        prefixes = push(prefixes, running)
    }
    prefixes |> map(|m| vector[m - 1]) |> sum()
}

# Only substrings weighing exactly the vector's length can be compared at all.
let candidates = range(0, len(proteome)) |> flat_map(|start|
    range(start + 1, len(proteome) + 1)
        |> map(|stop| substr(proteome, start, stop - start))
        |> filter(|piece| mass_of(piece, toy_masses) == total))

let ranked = candidates
    |> map(|piece| { piece: piece, score: score_of(piece, toy_masses, spectral) })
    |> sort_by(|entry| 0 - entry.score)

println("Candidates of the right mass: " + join(candidates, " "))
println("Result:   " + ranked[0].piece + "   score " + str(ranked[0].score))
println("Expected: ZXZXX")

fn test_ba11f_peptide_identification() {
    assert ranked[0].piece == "ZXZXX", "BA11F: got " + ranked[0].piece
    # It really is a substring of the proteome, and weighs the whole vector.
    assert contains(proteome, ranked[0].piece), "BA11F: the answer must occur in the proteome"
    assert mass_of(ranked[0].piece, toy_masses) == total,
        "BA11F: the peptide must weigh the vector's length"
    # Nothing else scores higher, and there was more than one candidate — so the
    # mass filter alone did not decide it.
    for entry in ranked {
        assert entry.score <= ranked[0].score, "BA11F: something outscores the answer"
    }
    assert len(candidates) > 1, "BA11F: several substrings have the right mass"
}

BA11G — Implement PSMSearch

solvedbrowser + CLI Problem statement Open in the workbench Download .bl

A real experiment produces thousands of spectra, most matching nothing. The threshold is what separates them — without it every spectrum gets a peptide and most assignments are wrong. One of the two sample spectra is correctly left unassigned.

# Rosalind: BA11G — Implement PSMSearch
# https://rosalind.info/problems/ba11g/
#
# Given: A set of spectral vectors, a proteome, and a threshold.
# Return: Every peptide-spectrum match scoring at least the threshold.

let spectra = [
    [-1, 5, -4, 5, 3, -1, -4, 5, -1, 0, 0, 4, -1, 0, 1, 4, 4, 4],
    [-4, 2, -2, -4, 4, -5, -1, 4, -1, 2, 5, -3, -1, 3, 2, -3],
]
let proteome = "XXXZXZXXZXZXXXZXXZX"
let threshold = 5
let toy_masses = { "X": 4, "Z": 5 }

# BA11F finds the best peptide for one spectrum whether or not it is any good.
# A real experiment produces thousands of spectra, most of which match nothing —
# they are noise, or peptides absent from the proteome. The threshold is what
# separates the two, and without it every spectrum would be assigned a peptide
# and most of those assignments would be wrong.
fn mass_of(piece, letters) { chars(piece) |> map(|c| letters[c]) |> sum() }

fn score_of(piece, letters, vector) {
    let running = 0
    let prefixes = []
    for residue in chars(piece) {
        running = running + letters[residue]
        prefixes = push(prefixes, running)
    }
    prefixes |> map(|m| vector[m - 1]) |> sum()
}

fn best_match(vector, source, letters) {
    let total = len(vector)
    let candidates = range(0, len(source)) |> flat_map(|start|
        range(start + 1, len(source) + 1)
            |> map(|stop| substr(source, start, stop - start))
            |> filter(|piece| mass_of(piece, letters) == total))
    if len(candidates) == 0 { return { piece: "", score: 0 - 1000000 } }
    (candidates
        |> map(|piece| { piece: piece, score: score_of(piece, letters, vector) })
        |> sort_by(|entry| 0 - entry.score))[0]
}

let matches = spectra
    |> map(|vector| best_match(vector, proteome, toy_masses))
    |> filter(|entry| entry.score >= threshold)
    |> map(|entry| entry.piece)
    |> unique()

println("Result:   " + join(matches, " "))
println("Expected: XZXZ")

fn test_ba11g_psm_search() {
    assert join(matches, " ") == "XZXZ", "BA11G: got " + join(matches, " ")
    # Exactly one of the two spectra clears the threshold — the other's best
    # match scores below it and is correctly left unassigned, which is the whole
    # purpose of the threshold.
    let scored = spectra |> map(|vector| best_match(vector, proteome, toy_masses))
    assert scored[0].score >= threshold, "BA11G: the first spectrum should match"
    assert scored[1].score < threshold,
        "BA11G: the second scores " + str(scored[1].score) + ", below the threshold"
    assert contains(proteome, matches[0]), "BA11G: the match must occur in the proteome"
}

BA11H — Compute the Size of a Spectral Dictionary

solvedbrowser + CLI Problem statement Open in the workbench Download .bl

If thousands of peptides would score as well, a high score means nothing. Counted rather than enumerated, for the same reason as BA4D — and cross-checked here against brute-force enumeration, which is only possible because this vector is tiny.

# Rosalind: BA11H — Compute the Size of a Spectral Dictionary
# https://rosalind.info/problems/ba11h/
#
# Given: A spectral vector, a threshold, and a maximum score.
# Return: How many peptides score within [threshold, max_score].

let spectral = [4, -3, -2, 3, 3, -4, 5, -3, -1, -1, 3, 4, 1, 3]
let threshold = 1
let max_score = 8
let toy_masses = { "X": 4, "Z": 5 }

# BA11G assigns a peptide to a spectrum, but how confident should anyone be? If
# thousands of peptides would have scored just as well, a high score means
# nothing. The spectral dictionary is that count — the number of peptides
# reaching a given score — and it is what turns a score into a statistical
# statement rather than a number.
#
# Counted rather than enumerated, for the same reason as BA4D: the dictionary can
# be astronomically large even when the count is quick to compute.
let residues = keys(toy_masses) |> map(|letter| toy_masses[letter])

# ways[mass][score] = how many peptides of that mass reach exactly that score.
# Scores can go negative, so they are shifted to keep indices non-negative.
let shift = 1000
# Built as a fresh record per mass, since nested index assignment is not
# available — only `ways[i] = record`.
let start_row = {}
start_row[str(shift)] = 1
let ways = [start_row]
for _ in range(1, len(spectral) + 1) { ways = push(ways, {}) }

for mass in range(1, len(spectral) + 1) {
    let here = {}
    for residue in residues {
        let previous = mass - residue
        if previous >= 0 {
            for key in keys(ways[previous]) {
                let new_score = int(key) + spectral[mass - 1]
                let existing = if contains(keys(here), str(new_score)) then here[str(new_score)] else 0
                here[str(new_score)] = existing + ways[previous][key]
            }
        }
    }
    ways[mass] = here
}

let final_scores = ways[len(spectral)]
let size = keys(final_scores)
    |> filter(|key| int(key) - shift >= threshold and int(key) - shift <= max_score)
    |> map(|key| final_scores[key])
    |> sum()

println("Result:   " + str(size))
println("Expected: 3")

fn test_ba11h_spectral_dictionary_size() {
    assert size == 3, "BA11H: got " + str(size)
    # Checked by enumeration, which is possible only because this vector is tiny
    # — the point of the counting version is that it stays possible when the
    # dictionary does not fit in memory.
    fn peptides_of_mass(target, letters) {
        let growing = [""]
        let complete = []
        for _ in range(0, target) {
            let extended = growing
                |> flat_map(|p| keys(letters) |> map(|c| p + c))
                |> filter(|p| (chars(p) |> map(|c| letters[c]) |> sum()) <= target)
            # Finished peptides are set aside rather than extended further —
            # carrying them on would push every one past the target and leave
            # nothing behind.
            complete = complete + (extended
                |> filter(|p| (chars(p) |> map(|c| letters[c]) |> sum()) == target))
            growing = extended
                |> filter(|p| (chars(p) |> map(|c| letters[c]) |> sum()) < target)
        }
        unique(complete)
    }
    let all_peptides = peptides_of_mass(len(spectral), toy_masses)
    let scored = all_peptides |> map(|p| {
        let running = 0
        let prefixes = []
        for residue in chars(p) {
            running = running + toy_masses[residue]
            prefixes = push(prefixes, running)
        }
        prefixes |> map(|m| spectral[m - 1]) |> sum()
    })
    let within = scored |> count_if(|s| s >= threshold and s <= max_score)
    assert within == size,
        "BA11H: counting says " + str(size) + " but enumeration finds " + str(within)
}

BA11I — Compute the Probability of a Spectral Dictionary

solvedbrowser + CLI Problem statement Open in the workbench Download .bl

What turns a match into evidence: a score of 8 means nothing alone, a score only 0.375 of random peptides reach means something. Asserted to agree with BA11H — three length-3 peptides at (1/2)^3 each.

# Rosalind: BA11I — Compute the Probability of a Spectral Dictionary
# https://rosalind.info/problems/ba11i/
#
# Given: A spectral vector, a threshold, and a maximum score.
# Return: The probability of the spectral dictionary.

let spectral = [4, -3, -2, 3, 3, -4, 5, -3, -1, -1, 3, 4, 1, 3]
let threshold = 1
let max_score = 8
let toy_masses = { "X": 4, "Z": 5 }

# BA11H counts the peptides reaching a score; this weights them. Every residue is
# taken as equally likely, so a peptide of length n has probability
# (1/|alphabet|)^n — and summing that over the dictionary gives the chance a
# random peptide would score as well as the observed match.
#
# That number is what turns a match into evidence. A score of 8 means nothing on
# its own; a score only 0.375 of random peptides reach means something, and a
# score one in a billion reach means a great deal more.
let residues = keys(toy_masses)
let share = 1.0 / len(residues)

# Same recurrence as BA11H, carrying probability instead of a count.
let shift = 1000
let start_row = {}
start_row[str(shift)] = 1.0
let ways = [start_row]
for _ in range(1, len(spectral) + 1) { ways = push(ways, {}) }

for mass in range(1, len(spectral) + 1) {
    let here = {}
    for letter in residues {
        let previous = mass - toy_masses[letter]
        if previous >= 0 {
            for key in keys(ways[previous]) {
                let new_score = int(key) + spectral[mass - 1]
                let existing = if contains(keys(here), str(new_score)) then here[str(new_score)] else 0.0
                here[str(new_score)] = existing + ways[previous][key] * share
            }
        }
    }
    ways[mass] = here
}

let final_scores = ways[len(spectral)]
let probability = keys(final_scores)
    |> filter(|key| int(key) - shift >= threshold and int(key) - shift <= max_score)
    |> map(|key| final_scores[key])
    |> sum()

println("Result:   " + str(probability))
println("Expected: 0.375")

fn test_ba11i_spectral_dictionary_probability() {
    assert abs(probability - 0.375) < 1e-9, "BA11I: got " + str(probability)
    # BA11H found 3 peptides in the dictionary, all of length 3, and each has
    # probability (1/2)^3 = 0.125 — so 3 * 0.125 = 0.375. The two problems have
    # to agree that way, which is worth checking rather than assuming.
    assert abs(3.0 * pow(share, 3) - probability) < 1e-9,
        "BA11I: three length-3 peptides at (1/2)^3 each should give the answer"
    # A probability, so between 0 and 1.
    assert probability >= 0.0 and probability <= 1.0, "BA11I: not a probability"
    # Widening the score window can only include more.
    let wider = keys(final_scores)
        |> filter(|key| int(key) - shift >= threshold - 5 and int(key) - shift <= max_score + 5)
        |> map(|key| final_scores[key])
        |> sum()
    assert wider >= probability, "BA11I: a wider window cannot be less likely"
}

BA11J — Find a Highest-Scoring Modified Peptide against a Spectrum

solvedbrowser + CLI Problem statement Open in the workbench Download .bl

Proteins are modified after they are made, so a modified peptide's spectrum matches nothing under exact search. XXZ weighs 13 against a vector of length 14, so at least one modification is forced — which the assertion checks rather than taking on trust.

# Rosalind: BA11J — Find a Highest-Scoring Modified Peptide against a Spectrum
# https://rosalind.info/problems/ba11j/
#
# Given: A peptide, a spectral vector, and an integer k.
# Return: A variant of the peptide, with at most k modified residues, scoring
# highest against the vector.

let peptide = "XXZ"
let spectral = [4, -3, -2, 3, 3, -4, 5, -3, -1, -1, 3, 4, 1, 3]
let allowed = 2
let toy_masses = { "X": 4, "Z": 5 }

# Proteins are chemically modified after they are made — phosphorylated,
# methylated, acetylated — and a modified residue weighs something other than the
# table says. A spectrum of a modified peptide therefore matches nothing under
# exact search, which is why identification has to allow for shifts.
#
# Spectral alignment: each residue may take a mass offset, at most k of them
# non-zero. The state is (which residue, what total mass so far, how many
# modifications used), and the answer is the best-scoring path through it. The
# peptide's own mass here is 13 against a vector of length 14, so at least one
# modification is forced.
let residue_masses = chars(peptide) |> map(|c| toy_masses[c])
let total = len(spectral)

# best[i][m][k] via a flat record keyed by the three indices.
fn key(i, m, used) { str(i) + "," + str(m) + "," + str(used) }

let best = {}
let came_from = {}
best[key(0, 0, 0)] = 0

for i in range(0, len(residue_masses)) {
    for m in range(0, total + 1) {
        for used in range(0, allowed + 1) {
            let from_key = key(i, m, used)
            if contains(keys(best), from_key) {
                # Every reachable mass for the next prefix. An unmodified step
                # adds the residue's own mass; anything else costs a modification.
                for next_mass in range(m + 1, total + 1) {
                    let shift = next_mass - m - residue_masses[i]
                    let cost = if shift == 0 then 0 else 1
                    if used + cost <= allowed {
                        let to_key = key(i + 1, next_mass, used + cost)
                        let candidate = best[from_key] + spectral[next_mass - 1]
                        let known = if contains(keys(best), to_key) then best[to_key] else 0 - 1000000
                        if candidate > known {
                            best[to_key] = candidate
                            came_from[to_key] = { at: from_key, shift: shift, mass: next_mass }
                        }
                    }
                }
            }
        }
    }
}

# The best complete variant: all residues placed, total mass reached.
let finals = range(0, allowed + 1)
    |> filter(|used| contains(keys(best), key(len(residue_masses), total, used)))
    |> map(|used| { used: used, score: best[key(len(residue_masses), total, used)] })
    |> sort_by(|entry| 0 - entry.score)

let at = key(len(residue_masses), total, finals[0].used)
let shifts = []
while contains(keys(came_from), at) {
    let step = came_from[at]
    shifts = [step.shift] + shifts
    at = step.at
}

let written = range(0, len(shifts)) |> map(|i| {
    let letter = substr(peptide, i, 1)
    if shifts[i] == 0 then letter
    else if shifts[i] > 0 then letter + "(+" + str(shifts[i]) + ")"
    else letter + "(" + str(shifts[i]) + ")"
}) |> join("")

println("Result:   " + written + "   score " + str(finals[0].score))
println("Expected: XX(-1)Z(+2)")

fn test_ba11j_spectral_alignment() {
    assert written == "XX(-1)Z(+2)", "BA11J: got " + written
    # At most k modifications, and here exactly two are used.
    let modified = shifts |> count_if(|s| s != 0)
    assert modified <= allowed, "BA11J: too many modifications"
    assert modified == 2, "BA11J: expected two modifications, got " + str(modified)
    # The shifts must carry the peptide's mass to the vector's length — that is
    # what forces a modification here at all.
    let unmodified_mass = sum(residue_masses)
    assert unmodified_mass == 13, "BA11J: XXZ weighs 13"
    assert unmodified_mass + sum(shifts) == total,
        "BA11J: the shifts must make up the difference to " + str(total)
    assert unmodified_mass != total, "BA11J: so at least one modification is forced"
}

BA3K — Generate Contigs from a Collection of Reads

solvedbrowser + CLI Problem statement Open in the workbench Download .bl

What assembly actually produces. BA3H asked for the genome, which needs an Eulerian path to exist and be unique — real data gives neither. Where the graph branches the reads genuinely do not say which way the genome went, so the honest output is the unambiguous stretches and no more.

# Rosalind: BA3K — Generate Contigs from a Collection of Reads
# https://rosalind.info/problems/ba3k/
#
# Given: A collection of k-mers Patterns.
# Return: The contigs from the de Bruijn graph of Patterns.

let patterns = ["ATG", "ATG", "TGT", "TGG", "CAT", "GGA", "GAT", "AGA"]
let k = 3

# What assembly actually produces. BA3H asked for *the* genome, which needs an
# Eulerian path to exist and be unique — real data gives neither. Wherever the
# graph branches, the reads genuinely do not say which way the genome went, so
# the honest output is the unambiguous stretches and no more. Those are the
# contigs, and their lengths are the standard measure of how good an assembly is.
let de_bruijn = {}
for pattern in patterns {
    let prefix = substr(pattern, 0, k - 1)
    let suffix = substr(pattern, 1, k - 1)
    if contains(keys(de_bruijn), prefix) {
        de_bruijn[prefix] = push(de_bruijn[prefix], suffix)
    } else {
        de_bruijn[prefix] = [suffix]
    }
}

let vertices = sort(unique(keys(de_bruijn) + (keys(de_bruijn) |> flat_map(|n| de_bruijn[n]))))
fn out_edges(node, graph) { if contains(keys(graph), node) then graph[node] else [] }

let in_degree = {}
for node in vertices { in_degree[node] = 0 }
for node in keys(de_bruijn) {
    for target in de_bruijn[node] { in_degree[target] = in_degree[target] + 1 }
}

fn is_one_in_one_out(node, graph, degrees) {
    degrees[node] == 1 and len(out_edges(node, graph)) == 1
}

# Maximal non-branching paths, exactly as in BA3M.
let paths = []
for node in vertices {
    if is_one_in_one_out(node, de_bruijn, in_degree) == false {
        for target in out_edges(node, de_bruijn) {
            let walk = [node, target]
            let at = target
            while is_one_in_one_out(at, de_bruijn, in_degree) {
                let onward = out_edges(at, de_bruijn)[0]
                walk = push(walk, onward)
                at = onward
            }
            paths = push(paths, walk)
        }
    }
}

# Spell each path, as in BA3H.
let contigs = sort(paths |> map(|walk|
    walk[0] + (range(1, len(walk)) |> map(|i| substr(walk[i], k - 2, 1)) |> join(""))))

println("Result:   " + join(contigs, " "))
println("Expected: AGA ATG ATG CAT GAT TGGA TGT")

fn test_ba3k_contig_generation() {
    assert join(contigs, " ") == "AGA ATG ATG CAT GAT TGGA TGT",
        "BA3K: got " + join(contigs, " ")
    # ATG appears twice, because two separate branches spell it — contigs are
    # listed per path, not deduplicated.
    assert (contigs |> count_if(|c| c == "ATG")) == 2, "BA3K: ATG is spelled by two paths"
    # TGGA is the only contig longer than k, which is exactly where the graph did
    # not branch. Everything else stops immediately.
    assert (contigs |> count_if(|c| len(c) > k)) == 1, "BA3K: only one contig extends past k"
    assert contains(contigs, "TGGA"), "BA3K: TGGA is the unambiguous stretch"
    # Every contig is spellable from the reads it came from.
    for contig in contigs {
        let pieces = range(0, len(contig) - k + 1) |> map(|i| substr(contig, i, k))
        for piece in pieces {
            assert contains(patterns, piece), "BA3K: " + contig + " uses a read that is not there"
        }
    }
}

BA3L — Construct a String Spelled by a Gapped Genome Path

solvedbrowser + CLI Problem statement Open in the workbench Download .bl

BA3J had to find the path; here it is given, so what remains is the overlap check — a path whose two halves disagree spells nothing at all, however valid it looked in the graph.

# Rosalind: BA3L — Construct a String Spelled by a Gapped Genome Path
# https://rosalind.info/problems/ba3l/
#
# Given: A sequence of (k,d)-mers already in path order.
# Return: The string they spell, if one exists.

let k = 4
let d = 2
let path = [
    "GACC|GCGC", "ACCG|CGCC", "CCGA|GCCG", "CGAG|CCGG", "GAGC|CGGA",
]

# BA3J had to find the path first; here it is given, so what remains is the
# spelling — and the check that the path is consistent at all. The two halves
# overlap by k+d characters once laid out, and if they disagree anywhere then no
# string has this paired composition, however valid the path looked in the graph.
fn halves(pair) { split(pair, "|") }

fn spell(nodes, which, width) {
    let head = halves(nodes[0])[which]
    head + (range(1, len(nodes)) |> map(|i| substr(halves(nodes[i])[which], width - 1, 1)) |> join(""))
}

let first_spelled = spell(path, 0, k)
let second_spelled = spell(path, 1, k)
let gap = k + d

let disagreements = range(gap, len(first_spelled))
    |> filter(|i| substr(first_spelled, i, 1) != substr(second_spelled, i - gap, 1))

let text = first_spelled + substr(second_spelled, len(second_spelled) - gap, gap)

println("Result:   " + text)
println("Expected: GACCGAGCGCCGGA")

fn test_ba3l_gapped_genome_path() {
    assert text == "GACCGAGCGCCGGA", "BA3L: got " + text
    # The overlap check is the substance of this problem, not a formality: a path
    # whose halves disagree spells nothing at all.
    assert len(disagreements) == 0,
        "BA3L: the two spellings disagree at " + str(disagreements)
    assert len(text) == len(path) + 2 * k + d - 1,
        "BA3L: n pairs spell n + 2k + d - 1 characters"
    # And the answer's own paired composition is the path it came from.
    let composition = range(0, len(text) - (2 * k + d) + 1)
        |> map(|i| substr(text, i, k) + "|" + substr(text, i + k + d, k))
    assert composition == path, "BA3L: the composition does not match the given path"
}

BA3M — Generate All Maximal Non-Branching Paths in a Graph

solvedbrowser + CLI Problem statement Open in the workbench Download .bl

A run of 1-in-1-out nodes carries no choice, so collapsing it loses nothing; everywhere else is a real branch. The isolated cycle has no non-branching start and is only found by a second pass — without it, it would be silently dropped. Reported from 6 rather than 7, since a cycle has no first node.

# Rosalind: BA3M — Generate All Maximal Non-Branching Paths in a Graph
# https://rosalind.info/problems/ba3m/
#
# Given: The adjacency list of a directed graph.
# Return: Every maximal non-branching path.

let adjacency = {
    "1": ["2"], "2": ["3"], "3": ["4", "5"], "6": ["7"], "7": ["6"],
}

# A run of nodes with one edge in and one out carries no choice — nothing about
# the graph is lost by collapsing it to a single path. Everywhere else there is a
# genuine branch, and that is where an assembly has to stop and admit it does not
# know which way the genome went. This is the operation that turns a de Bruijn
# graph into contigs.
let vertices = sort(unique(keys(adjacency) + (keys(adjacency) |> flat_map(|k| adjacency[k]))))

fn out_edges(node, graph) { if contains(keys(graph), node) then graph[node] else [] }

let in_degree = {}
for node in vertices { in_degree[node] = 0 }
for node in keys(adjacency) {
    for target in adjacency[node] { in_degree[target] = in_degree[target] + 1 }
}

fn is_one_in_one_out(node, graph, degrees) {
    degrees[node] == 1 and len(out_edges(node, graph)) == 1
}

let paths = []
let used = {}
for node in vertices {
    if is_one_in_one_out(node, adjacency, in_degree) == false {
        for target in out_edges(node, adjacency) {
            let walk = [node, target]
            used[node + "->" + target] = true
            let at = target
            while is_one_in_one_out(at, adjacency, in_degree) {
                let onward = out_edges(at, adjacency)[0]
                used[at + "->" + onward] = true
                walk = push(walk, onward)
                at = onward
            }
            paths = push(paths, walk)
        }
    }
}

# Isolated cycles: every node 1-in-1-out, so no starting point was ever found.
for node in vertices {
    if is_one_in_one_out(node, adjacency, in_degree) {
        let first_edge = node + "->" + out_edges(node, adjacency)[0]
        if contains(keys(used), first_edge) == false {
            let walk = [node]
            let at = node
            let going = true
            while going {
                let onward = out_edges(at, adjacency)[0]
                used[at + "->" + onward] = true
                walk = push(walk, onward)
                at = onward
                if at == node { going = false }
            }
            paths = push(paths, walk)
        }
    }
}

let listed = sort(paths |> map(|p| join(p, " -> ")))

println("Result:")
for line in listed { println("  " + line) }
println("Expected: 1 -> 2 -> 3 / 3 -> 4 / 3 -> 5 / 7 -> 6 -> 7")
println("(the cycle is printed from 6 rather than 7 — a cycle has no first node)")

fn test_ba3m_maximal_non_branching_paths() {
    # The three linear paths are pinned down exactly; the cycle is only pinned
    # up to where it starts, because 6 -> 7 -> 6 and 7 -> 6 -> 7 are the same
    # cycle traversed from different nodes.
    for wanted in ["1 -> 2 -> 3", "3 -> 4", "3 -> 5"] {
        assert contains(listed, wanted), "BA3M: missing " + wanted
    }
    assert len(listed) == 4, "BA3M: expected 4 paths, got " + str(len(listed))
    let cycles = paths |> filter(|p| p[0] == p[len(p) - 1])
    assert len(cycles) == 1, "BA3M: exactly one isolated cycle"
    assert sort(unique(cycles[0])) == ["6", "7"], "BA3M: the cycle runs through 6 and 7"
    # Every edge belongs to exactly one path — the paths partition the graph,
    # which is what makes them a lossless summary of it.
    let edge_count = keys(adjacency) |> map(|node| len(adjacency[node])) |> sum()
    let covered = paths |> map(|p| len(p) - 1) |> sum()
    assert covered == edge_count,
        "BA3M: paths cover " + str(covered) + " edges of " + str(edge_count)
    # The 6-7 cycle has no non-branching start, so it is only found by the second
    # pass — without which it would be silently dropped.
    assert len(cycles) == 1, "BA3M: the isolated cycle must be reported"
}

BA9R — Construct a Suffix Tree from a Suffix Array

solvedbrowser + CLI Problem statement Open in the workbench Download .bl

BA9C built the tree by collapsing a suffix trie, which is quadratic before the collapse. The suffix and LCP arrays carry the same information in two flat integer arrays and rebuild the tree in one pass — which is why real tools store the arrays and never materialise the tree.

# Rosalind: BA9R — Construct a Suffix Tree from a Suffix Array
# https://rosalind.info/problems/ba9r/
#
# Given: A string, its suffix array and its LCP array.
# Return: The edge labels of the suffix tree, in any order.

let text = "GTAGT$"

# BA9C built the tree by inserting every suffix into a trie and collapsing it,
# which costs O(n^2) time and memory before the collapse. The suffix array and
# LCP array carry the same information in two flat integer arrays, and the tree
# can be rebuilt from them in one left-to-right pass — so a structure that was
# quadratic to build becomes linear given arrays that are themselves linear.
#
# That is why real tools store the arrays and never materialise the tree.
let sa = suffix_array(text)
let lcp = lcp_array(text)

println("Suffix array: " + (sa |> map(|v| str(v)) |> join(", ")))
println("LCP array:    " + (lcp |> map(|v| str(v)) |> join(", ")))

# Two passes, because a leaf's edge depends on what comes *after* it as well as
# before. The node a leaf hangs from sits at depth max(lcp[i], lcp[i+1]) — the
# deeper of what it shares with either neighbour — so the leaf edge is whatever
# is left of the suffix below that depth.
let leaf_labels = range(0, len(sa)) |> map(|i| {
    let before = if i == 0 then 0 else lcp[i]
    let after = if i + 1 < len(sa) then lcp[i + 1] else 0
    let depth = max([before, after])
    substr(text, sa[i] + depth, len(text) - sa[i] - depth)
})

# The internal nodes come from the LCP array alone: a run of suffixes sharing a
# prefix of length L hangs off one node at depth L, and a stack tracks which are
# still open as the array is scanned.
let internal_labels = []
let stack = [{ depth: 0, start: 0 }]
for i in range(1, len(sa)) {
    let shared = lcp[i]
    let last_start = sa[i]
    while stack[len(stack) - 1].depth > shared {
        let closing = stack[len(stack) - 1]
        stack = slice(stack, 0, len(stack) - 1)
        let parent_depth = max([stack[len(stack) - 1].depth, shared])
        internal_labels = push(internal_labels,
            substr(text, closing.start + parent_depth, closing.depth - parent_depth))
        last_start = closing.start
    }
    if stack[len(stack) - 1].depth < shared {
        stack = push(stack, { depth: shared, start: last_start })
    }
}
while len(stack) > 1 {
    let closing = stack[len(stack) - 1]
    stack = slice(stack, 0, len(stack) - 1)
    let parent_depth = stack[len(stack) - 1].depth
    internal_labels = push(internal_labels,
        substr(text, closing.start + parent_depth, closing.depth - parent_depth))
}

let labels = leaf_labels + internal_labels

println("Result:   " + join(sort(labels), " "))
println("Expected (any order): $ T AGT$ $ AGT$ GT $ AGT$")

fn test_ba9r_suffix_tree_from_arrays() {
    let expected = ["$", "T", "AGT$", "$", "AGT$", "GT", "$", "AGT$"]
    assert sort(labels) == sort(expected), "BA9R: got " + join(sort(labels), " ")
    assert len(labels) == 8, "BA9R: expected 8 edges, got " + str(len(labels))
    # One leaf per suffix, and every leaf edge ends at the sentinel.
    assert len(leaf_labels) == len(text), "BA9R: one leaf per suffix"
    for label in leaf_labels {
        assert substr(label, len(label) - 1, 1) == "$", "BA9R: a leaf edge must reach the end"
    }
    # The internal edges are the shared prefixes: GT and T, each shared by two
    # suffixes.
    assert sort(internal_labels) == ["GT", "T"], "BA9R: got internals " + str(internal_labels)
    # Every label is a real substring of the text.
    for label in labels {
        assert contains(text, label), "BA9R: " + label + " is not in the text"
    }
}