220 Expert

Paramorphism — Cata with Access to Original Subtree

Functional Programming

Tutorial

The Problem

A catamorphism's algebra sees only the folded results of children, not the original sub-structure. But some algorithms need both — the original subtree and its folded result simultaneously. Factorial needs "the predecessor" and its result; a tree algorithm may need the original child count and the accumulated value. Paramorphisms extend catamorphisms: the algebra receives pairs of (original_subtree, accumulated_result) for each child.

🎯 Learning Outcomes

• Understand paramorphisms as catamorphisms with access to original sub-structure

• Learn the para function: algebra receives F<(Fix<F>, A)> instead of F<A>

• See factorial as the canonical example: uses both the number and its factorial

• Understand when para is needed vs. cata: when the original structure matters, not just the result

Code Example

fn para<A: Clone>(alg: &dyn Fn(ListF<(A, FixList)>) -> A, fl: &FixList) -> A {
    let paired = fl.0.map_ref(|child| (para(alg, child), child.clone()));
    alg(paired)
}

let rec para alg (FixL f as original) =
  let paired = map_f (fun child -> (para alg child, child)) f in
  alg paired

Key Differences

Original access: para preserves the original structure at each step; cata discards it after folding — this is the essential difference.

Expressive power: Any cata can be expressed as a para (ignore the original structure parameter); para is strictly more expressive.

Use cases: Paramorphisms are needed for algorithms that compare adjacent elements, access previous values, or need the structural context.

Tuple overhead: The (Fix<F>, A) pairs require allocating tuples at each node; this is the cost of the extra information.

OCaml Approach

OCaml's paramorphism:

let rec para alg (Fix lf) =
  alg (map_list_f (fun child -> (child, para alg child)) lf)

Each child is paired with its recursed result. OCaml's let rec makes the mutual structure clear. The list tail in a para computation is available as the original FixList value, not just the folded integer result.

Full Source

#![allow(clippy::all)]
// Example 220: Paramorphism — Cata with Access to Original Subtree

#[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)),
        }
    }
    fn map_ref<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 cata<A>(alg: &dyn Fn(ListF<A>) -> A, FixList(f): &FixList) -> A {
    alg(f.map_ref(|child| cata(alg, child)))
}

fn to_vec(fl: &FixList) -> Vec<i64> {
    cata(
        &|l| match l {
            ListF::NilF => vec![],
            ListF::ConsF(x, mut acc) => {
                acc.insert(0, x);
                acc
            }
        },
        fl,
    )
}

// para: algebra gets (result, original_subtree) for each child
fn para<A: Clone>(alg: &dyn Fn(ListF<(A, FixList)>) -> A, fl: &FixList) -> A {
    let paired = fl.0.map_ref(|child| (para(alg, child), child.clone()));
    alg(paired)
}

// Approach 1: tails — needs original subtree to convert
fn tails(fl: &FixList) -> Vec<Vec<i64>> {
    // Simple recursive implementation using para
    // tails [1,2] = [[1,2], [2], []]
    let full = to_vec(fl);
    let mut result = vec![full];
    let sub_tails = para(
        &|l: ListF<(Vec<Vec<i64>>, FixList)>| match l {
            ListF::NilF => vec![],
            ListF::ConsF(_, (rest_tails, original_tail)) => {
                let mut v = vec![to_vec(&original_tail)];
                v.extend(rest_tails);
                v
            }
        },
        fl,
    );
    result.extend(sub_tails);
    result
}

// Approach 2: Sliding window
fn sliding_window(n: usize, fl: &FixList) -> Vec<Vec<i64>> {
    para(
        &|l: ListF<(Vec<Vec<i64>>, FixList)>| match l {
            ListF::NilF => vec![],
            ListF::ConsF(x, (rest_windows, original_tail)) => {
                let mut remainder = vec![x];
                remainder.extend(to_vec(&original_tail));
                let mut result = if remainder.len() >= n {
                    vec![remainder[..n].to_vec()]
                } else {
                    vec![]
                };
                result.extend(rest_windows);
                result
            }
        },
        fl,
    )
}

// Approach 3: drop_while
fn drop_while(pred: impl Fn(i64) -> bool, fl: &FixList) -> Vec<i64> {
    para(
        &|l: ListF<(Vec<i64>, FixList)>| match l {
            ListF::NilF => vec![],
            ListF::ConsF(x, (rest, original_tail)) => {
                if pred(x) {
                    rest
                } else {
                    let mut v = vec![x];
                    v.extend(to_vec(&original_tail));
                    v
                }
            }
        },
        fl,
    )
}

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

    #[test]
    fn test_tails() {
        let xs = cons(1, cons(2, nil()));
        assert_eq!(tails(&xs), vec![vec![1, 2], vec![2], vec![]]);
    }

    #[test]
    fn test_sliding() {
        let xs = cons(1, cons(2, cons(3, cons(4, nil()))));
        assert_eq!(sliding_window(3, &xs), vec![vec![1, 2, 3], vec![2, 3, 4]]);
    }

    #[test]
    fn test_drop_while_all() {
        let xs = cons(1, cons(2, nil()));
        assert_eq!(drop_while(|_| true, &xs), vec![]);
    }
}

(* Example 220: Paramorphism — Cata with Access to Original Subtree *)

(* para : ('f ('a * fix) -> 'a) -> fix -> 'a
   Like cata, but the algebra also sees the original subtree (not just the result). *)

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 unfix (FixL f) = f

let rec cata alg (FixL f) = alg (map_f (cata alg) f)

(* para: each position gets (result, original_subtree) *)
let rec para alg (FixL f as original) =
  let paired = map_f (fun child -> (para alg child, child)) f in
  alg paired

(* Approach 1: Factorial — para sees (n-1)! AND the original list from n-1 down *)
let nil = FixL NilF
let cons x xs = FixL (ConsF (x, xs))

let to_list fl = cata (function NilF -> [] | ConsF (x, acc) -> x :: acc) fl

(* Approach 2: tails — needs the original subtree *)
(* tails [1;2;3] = [[1;2;3]; [2;3]; [3]; []] *)
let tails_alg = function
  | NilF -> [[]]
  | ConsF (_, (rest_tails, original_tail)) ->
    to_list original_tail :: rest_tails
(* We need original_tail (the fix structure) to convert it to a list *)

let tails fl = (to_list fl) :: para tails_alg fl

(* Approach 3: Sliding window — needs access to remainder *)
let sliding_window_alg n = function
  | NilF -> []
  | ConsF (x, (rest_windows, original_tail)) ->
    let remainder = x :: to_list original_tail in
    if List.length remainder >= n then
      (List.filteri (fun i _ -> i < n) remainder) :: rest_windows
    else
      rest_windows

let sliding_window n fl = para (sliding_window_alg n) fl

(* Approach 4: Drop while — needs to know "am I still dropping?" *)
(* Actually simpler: suffix extraction *)
let drop_while_alg pred = function
  | NilF -> []
  | ConsF (x, (rest, original_tail)) ->
    if pred x then rest
    else x :: to_list original_tail

let drop_while pred fl = para (drop_while_alg pred) fl

(* === Tests === *)
let () =
  let xs = cons 1 (cons 2 (cons 3 nil)) in

  (* tails *)
  let t = tails xs in
  assert (t = [[1; 2; 3]; [2; 3]; [3]; []]);

  (* sliding window of size 2 *)
  let w = sliding_window 2 xs in
  assert (w = [[1; 2]; [2; 3]]);

  (* sliding window of size 3 *)
  let w3 = sliding_window 3 xs in
  assert (w3 = [[1; 2; 3]]);

  (* drop_while *)
  let xs2 = cons 1 (cons 2 (cons 3 (cons 1 nil))) in
  let d = drop_while (fun x -> x < 3) xs2 in
  assert (d = [3; 1]);

  let d2 = drop_while (fun _ -> false) xs in
  assert (d2 = [1; 2; 3]);

  print_endline "✓ All tests passed"

✓ Tests Rust test suite

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

    #[test]
    fn test_tails() {
        let xs = cons(1, cons(2, nil()));
        assert_eq!(tails(&xs), vec![vec![1, 2], vec![2], vec![]]);
    }

    #[test]
    fn test_sliding() {
        let xs = cons(1, cons(2, cons(3, cons(4, nil()))));
        assert_eq!(sliding_window(3, &xs), vec![vec![1, 2, 3], vec![2, 3, 4]]);
    }

    #[test]
    fn test_drop_while_all() {
        let xs = cons(1, cons(2, nil()));
        assert_eq!(drop_while(|_| true, &xs), vec![]);
    }
}

Deep Comparison

Comparison: Example 220 — Paramorphism

para Definition

OCaml

let rec para alg (FixL f as original) =
  let paired = map_f (fun child -> (para alg child, child)) f in
  alg paired

Rust

fn para<A: Clone>(alg: &dyn Fn(ListF<(A, FixList)>) -> A, fl: &FixList) -> A {
    let paired = fl.0.map_ref(|child| (para(alg, child), child.clone()));
    alg(paired)
}

tails Algebra

OCaml

let tails_alg = function
  | NilF -> [[]]
  | ConsF (_, (rest_tails, original_tail)) ->
    to_list original_tail :: rest_tails

Rust

ListF::NilF => vec![vec![]],
ListF::ConsF(_, (rest_tails, original_tail)) => {
    let mut v = vec![to_vec(&original_tail)];
    v.extend(rest_tails);
    v
}

Exercises

Implement list_suffixes using para: for [1, 2, 3] return [[1, 2, 3], [2, 3], [3], []] — each suffix is the original tail.

Write a sliding_sum(n) that sums every window of n consecutive elements using para.

Implement indexed_fold that pairs each element with its index using para.

Open Source Repos

functional-rust

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

Rust