221 Expert

Apomorphism — Ana that Can Short-Circuit

Functional Programming

Tutorial

The Problem

An anamorphism unfolds a seed step by step until the base case. But some unfolding algorithms know partway through that the rest of the structure is already built — they want to "embed" an existing structure rather than continuing to unfold. Apomorphisms extend anamorphisms with this short-circuit capability: the coalgebra can return either a new seed (continue unfolding) or an existing Fix<F> value (embed directly). This is the dual of a paramorphism.

🎯 Learning Outcomes

• Understand apomorphisms as anamorphisms with early termination (embedding existing structures)

• Learn how Either<Fix<F>, S> in the coalgebra return type enables short-circuiting

• See list insertion as the canonical example: insert an element, then embed the tail

• Understand the duality: apo is to ana as para is to cata

Code Example

fn apo<S>(coalg: &dyn Fn(S) -> ListF<Either<FixList, S>>, seed: S) -> FixList {
    FixList(Box::new(coalg(seed).map(|either| match either {
        Either::Left(fix) => fix,
        Either::Right(s) => apo(coalg, s),
    })))
}

let rec apo coalg seed =
  FixL (map_f (function
    | Left fix -> fix
    | Right s -> apo coalg s
  ) (coalg seed))

Key Differences

Short-circuit power: apo terminates early by embedding existing structures; ana must unfold everything from scratch — apo is strictly more expressive.

Duality with para: apo : Seed -> Fix mirrors para : Fix -> Result dually; the "embed" vs. "expose" distinction is the symmetric difference.

Practical use: Sorted list insertion, search tree insertion with path copying, and "insert and replace" operations in functional structures are natural apomorphisms.

Either in coalgebra: The Either<Fix<F>, S> return type is the key innovation; Right(seed) continues, Left(fix_value) short-circuits.

OCaml Approach

OCaml's apomorphism:

let rec apo coalg seed =
  Fix (map_list_f (function
    | Left existing -> existing
    | Right new_seed -> apo coalg new_seed)
  (coalg seed))

The Either (called result or a custom type in OCaml) is the mechanism for short-circuiting. OCaml's pattern matching on Left/Right is direct and readable.

Full Source

#![allow(clippy::all)]
// Example 221: Apomorphism — Ana that Can Short-Circuit

#[derive(Debug, Clone)]
enum ListF<A> {
    NilF,
    ConsF(i64, A),
}

impl<A> ListF<A> {
    fn map<B>(self, f: impl Fn(A) -> B) -> ListF<B> {
        match self {
            ListF::NilF => ListF::NilF,
            ListF::ConsF(x, a) => ListF::ConsF(x, f(a)),
        }
    }
}

#[derive(Debug, Clone)]
struct FixList(Box<ListF<FixList>>);

fn nil() -> FixList {
    FixList(Box::new(ListF::NilF))
}
fn cons(x: i64, xs: FixList) -> FixList {
    FixList(Box::new(ListF::ConsF(x, xs)))
}

fn to_vec(fl: &FixList) -> Vec<i64> {
    let mut result = vec![];
    let mut cur = fl;
    loop {
        match cur.0.as_ref() {
            ListF::NilF => break,
            ListF::ConsF(x, rest) => {
                result.push(*x);
                cur = rest;
            }
        }
    }
    result
}

// Either: Left = pre-built Fix (stop), Right = seed (continue)
enum Either<L, R> {
    Left(L),
    Right(R),
}

// apo: coalgebra returns F<Either<Fix, Seed>>
fn apo<S>(coalg: &dyn Fn(S) -> ListF<Either<FixList, S>>, seed: S) -> FixList {
    FixList(Box::new(coalg(seed).map(|either| match either {
        Either::Left(fix) => fix,          // short-circuit
        Either::Right(s) => apo(coalg, s), // continue
    })))
}

// Approach 1: Insert into sorted list
fn insert(x: i64, lst: FixList) -> FixList {
    apo(
        &|fl: FixList| match fl.0.as_ref() {
            ListF::NilF => ListF::ConsF(x, Either::Left(nil())),
            ListF::ConsF(y, rest) => {
                if x <= *y {
                    ListF::ConsF(x, Either::Left(fl.clone()))
                } else {
                    ListF::ConsF(*y, Either::Right(rest.clone()))
                }
            }
        },
        lst,
    )
}

// Approach 2: Take n elements
fn take(n: usize, lst: FixList) -> FixList {
    apo(
        &|s: (usize, FixList)| {
            let (n, fl) = s;
            if n == 0 {
                return ListF::NilF;
            }
            match fl.0.as_ref() {
                ListF::NilF => ListF::NilF,
                ListF::ConsF(x, rest) => ListF::ConsF(*x, Either::Right((n - 1, rest.clone()))),
            }
        },
        (n, lst),
    )
}

// Approach 3: Replace first occurrence
fn replace_first(target: i64, replacement: i64, lst: FixList) -> FixList {
    apo(
        &|fl: FixList| match fl.0.as_ref() {
            ListF::NilF => ListF::NilF,
            ListF::ConsF(x, rest) => {
                if *x == target {
                    ListF::ConsF(replacement, Either::Left(rest.clone()))
                } else {
                    ListF::ConsF(*x, Either::Right(rest.clone()))
                }
            }
        },
        lst,
    )
}

#[cfg(test)]
mod tests {
    use super::*;

    #[test]
    fn test_insert_middle() {
        let l = cons(1, cons(3, nil()));
        assert_eq!(to_vec(&insert(2, l)), vec![1, 2, 3]);
    }

    #[test]
    fn test_take_empty() {
        assert_eq!(to_vec(&take(5, nil())), vec![]);
    }

    #[test]
    fn test_replace_not_found() {
        let l = cons(1, cons(2, nil()));
        assert_eq!(to_vec(&replace_first(99, 0, l)), vec![1, 2]);
    }
}

(* Example 221: Apomorphism — Ana that Can Short-Circuit *)

(* apo : ('a -> 'f (Either fix 'a)) -> 'a -> fix
   Like ana, but at each step you can either:
   - Right seed: continue unfolding
   - Left fix:   inject a pre-built subtree (short-circuit) *)

type 'a list_f = NilF | ConsF of int * 'a

let map_f f = function NilF -> NilF | ConsF (x, a) -> ConsF (x, f a)

type fix_list = FixL of fix_list list_f

let rec ana coalg seed = FixL (map_f (ana coalg) (coalg seed))

(* apo: coalgebra returns Either fix_list seed *)
let rec apo coalg seed =
  let layer = coalg seed in
  FixL (map_f (function
    | Either.Left fix -> fix        (* pre-built, stop *)
    | Either.Right s -> apo coalg s (* continue unfolding *)
  ) layer)

(* Since OCaml doesn't have Either built-in, define it *)
type ('a, 'b) either = Left of 'a | Right of 'b

let rec apo coalg seed =
  let layer = coalg seed in
  FixL (map_f (function
    | Left fix -> fix
    | Right s -> apo coalg s
  ) layer)

(* Approach 1: Insert into sorted list — short-circuit with remainder *)
let insert_coalg x = function
  | FixL NilF -> ConsF (x, Left (FixL NilF))
  | FixL (ConsF (y, rest)) as original ->
    if x <= y then ConsF (x, Left original)  (* short-circuit: keep rest as-is *)
    else ConsF (y, Right rest)                 (* continue searching *)

let insert x lst = apo (insert_coalg x) lst

(* Approach 2: Take n elements — short-circuit after n *)
let take_coalg n = function
  | _, FixL NilF -> NilF
  | 0, _ -> NilF
  | n, FixL (ConsF (x, rest)) ->
    ConsF (x, Right (n - 1, rest))

let take n lst = apo (fun (n, lst) -> take_coalg n (n, lst)) (n, lst)

(* Approach 3: Replace first occurrence *)
let replace_first_coalg (target, replacement) = function
  | FixL NilF -> NilF
  | FixL (ConsF (x, rest)) ->
    if x = target then ConsF (replacement, Left rest)  (* found it, short-circuit *)
    else ConsF (x, Right rest)  (* keep looking *)

let replace_first target replacement lst =
  apo (replace_first_coalg (target, replacement)) lst

(* Helpers *)
let nil = FixL NilF
let cons x xs = FixL (ConsF (x, xs))
let rec to_list (FixL f) = match f with
  | NilF -> []
  | ConsF (x, rest) -> x :: to_list rest

(* === Tests === *)
let () =
  let sorted = cons 1 (cons 3 (cons 5 nil)) in

  (* Insert *)
  assert (to_list (insert 2 sorted) = [1; 2; 3; 5]);
  assert (to_list (insert 0 sorted) = [0; 1; 3; 5]);
  assert (to_list (insert 6 sorted) = [1; 3; 5; 6]);

  (* Take *)
  let xs = cons 1 (cons 2 (cons 3 (cons 4 (cons 5 nil)))) in
  assert (to_list (take 3 xs) = [1; 2; 3]);
  assert (to_list (take 0 xs) = []);
  assert (to_list (take 10 xs) = [1; 2; 3; 4; 5]);

  (* Replace first *)
  let xs2 = cons 1 (cons 2 (cons 3 (cons 2 nil))) in
  assert (to_list (replace_first 2 99 xs2) = [1; 99; 3; 2]);

  print_endline "✓ All tests passed"

✓ Tests Rust test suite

#[cfg(test)]
mod tests {
    use super::*;

    #[test]
    fn test_insert_middle() {
        let l = cons(1, cons(3, nil()));
        assert_eq!(to_vec(&insert(2, l)), vec![1, 2, 3]);
    }

    #[test]
    fn test_take_empty() {
        assert_eq!(to_vec(&take(5, nil())), vec![]);
    }

    #[test]
    fn test_replace_not_found() {
        let l = cons(1, cons(2, nil()));
        assert_eq!(to_vec(&replace_first(99, 0, l)), vec![1, 2]);
    }
}

Deep Comparison

Comparison: Example 221 — Apomorphism

apo Definition

OCaml

let rec apo coalg seed =
  FixL (map_f (function
    | Left fix -> fix
    | Right s -> apo coalg s
  ) (coalg seed))

Rust

fn apo<S>(coalg: &dyn Fn(S) -> ListF<Either<FixList, S>>, seed: S) -> FixList {
    FixList(Box::new(coalg(seed).map(|either| match either {
        Either::Left(fix) => fix,
        Either::Right(s) => apo(coalg, s),
    })))
}

Insert into Sorted List

OCaml

let insert_coalg x = function
  | FixL NilF -> ConsF (x, Left (FixL NilF))
  | FixL (ConsF (y, rest)) as original ->
    if x <= y then ConsF (x, Left original)   (* short-circuit *)
    else ConsF (y, Right rest)                  (* continue *)

Rust

apo(&|fl: FixList| match fl.0.as_ref() {
    ListF::NilF => ListF::ConsF(x, Either::Left(nil())),
    ListF::ConsF(y, rest) =>
        if x <= *y { ListF::ConsF(x, Either::Left(fl.clone())) }
        else { ListF::ConsF(*y, Either::Right(rest.clone())) },
}, lst)

Exercises

Implement sorted insertion for a Vec<i64> using apo and verify the result is sorted.

Write apo_take(n, seed) that generates at most n elements from an infinite coalgebra by short-circuiting after n steps.

Implement replace_first(pred, new_val, list) using apo: replace the first element satisfying pred, then embed the rest unchanged.

Open Source Repos

functional-rust

View the source for this example on GitHub — OCaml and Rust side by side in the repo.

Rust