Introduction

Earlier this spring, I was idly brainstorming potential final projects for my Functional Programming students. Having just taught my Discrete Math students the Fundamental Theorem of Arithmetic, I wondered whether formalizingI mean formalizing it from scratch: of course, the FTA is already in the Agda standard library. As I later learned, it was added to the standard library by Nathan van Doorn, aka Taneb.

it in Agda could make a nice project.

So I decided to spend about an hour trying to prove it in Agda, to gauge the level of the project. At the end of an hour, I had learned two things: (1) proving the Fundamental Theorem of Arithmetic is not an appropriate project for my students (who had only had a few weeks’ practice with Agda); (2) I was not going to be able to stop until I finished the proof myself!

Over the next week or so, I finished the proof completely from scratch—without using anything from the standard library, and without looking up any reference material. I based it only on my experience in Agda, knowledge of the relevant proofs on an informal level, and Agda techniques I’ve picked up along the way (from e.g. Conor McBride, Jacques Carette, colleagues at Penn, and elsewhere).

I decided to publish the proof, with extra commentary, in the hopes that it can be useful as an intermediate-level reference. That is, perhaps you’ve learned some basic Agda (if not, I suggest this tutorial to start) and have some basic familiarity with the Curry-Howard correspondence, but would benefit from seeing an example of a fully worked out, medium-sized proof.Another good source of information along these lines is this post by Jesper Cockx.

The resulting blog post is extremely long, but I make no apologies for that—if you want an entertaining 5-minute read, you should look elsewhere!

The entire blog post and proof is available as a literate Agda document. Even better, I have also published another version of this blog post with holes in place of almost all the proofs. For a maximal learning experience, I suggest downloading it and trying to fill in the holes yourself as you go along.

Below is a table of contents. Depending on your background, you may of course choose to skip some sections. For example, if you have already had a good deal of practice dealing with basic natural number arithmetic, equality, and inequality in Agda, you might wish to skip over those sections.

Table of Contents

• Introduction
• (Half of) The Fundamental Theorem of Arithmetic (Constructively)
• Preliminaries
• Basic logic
• Equality
• Natural numbers
  • No confusion
  • Decidable equality
• Addition
• Multiplication
• Inequality
  • Relationships among equality and inequality
  • Arithmetic and inequality
• Divisibility, primes, and composites
  • Nontrivial divisors come in pairs
• Division
• Absolute difference
• Quotient and remainder are unique
• The division algorithm, take 1
  • Construct the evidence you would like to pattern-match on
• Well-founded induction
  • Accessibility
  • Well-founded induction, defined
  • Less-than is well-founded
• The division algorithm
• Primality testing
  • Counting up
  • Primality testing by trial division
• Lists
• The Fundamental Theorem of Arithmetic
• Further Directions

(Half of) The Fundamental Theorem of Arithmetic (Constructively)

The Fundamental Theorem of Arithmetic (FTA for short) states that any natural number \(n \geq 1\) can be written as a product of zero or more primes, and moreover that this product is unique up to permutation.

For now, we are only going to prove the existence part (I may write another blog post with the uniqueness proof later). Since a constructive existence proof is really an algorithm for constructing the thing that is claimed to exist, this can also be seen as a formally verified factorization program: put any number in, get a prime factorization out. Writing a prime factorization program is not hard, of course; it’s the formal verification part that is interesting!

Stop! Before reading on, if you want to get the most out of this tutorial, I strongly recommend downloading the version with holes and trying to complete as many of the proofs as you can before reading mine!

Preliminaries

We will often make use of A and B to stand for arbitrary sets/types, so we use a variable declaration to tell Agda that it should implicitly quantify them whenever they show up as free variables. That way we don’t have to write {A B : Set} → ... all the time.

variable
  A B : Set

Basic logic

Since we’re building this completely from scratch, we start with some types to represent basic logical building blocks (via the Curry-Howard correspondence). First, the “top” type ⊤ to stand for truth, i.e. a proposition with trivial evidence:

data ⊤ : Set where
  tt : ⊤

tt is declared to be the one and only value of type ⊤.

Note that some things we define here—such as ⊤—will have the same names as they do in the Agda standard library. However, many things won’t, since I either didn’t know the standard name and made up my own, or (in a few cases) did know the standard name but didn’t like it, and made up my own anyway.

Next, the “bottom” type ⊥ with no constructors, representing falsity, along with a corresponding elimination principle, absurd. The elimination principle says that anything follows from ⊥ (“ex falso quodlibet”), and is implemented using Agda’s absurd pattern, written (). If Agda can tell that there are no possible constructors which could give rise to a value of a certain type, we can pattern-match on it with (), and are absolved of providing a right-hand side for the definition in that case.

data ⊥ : Set where

absurd : ⊥ → A
absurd ()

We can now define negation as an implication to ⊥.

¬ : Set → Set
¬ P = P → ⊥

Dependent pairs are next: a pair of values where the type of the second component can depend on the value of the first. That is, a value of type Σ A B is a value a of type A paired with a value of type B a. Via Curry-Howard, this is used to represent existential quantification: a (constructive) proof of \(\exists a : A.\; B(a)\) is a value \(a\) of type \(A\) (the witness) paired with a proof that \(a\) has property \(B\) (i.e. a value of type \(B(a)\)).

infixr 1 _,_
data Σ (A : Set) (B : A → Set) : Set where
  _,_ : (a : A) → B a → Σ A B

We also define a projection function (we only end up needing fst; defining snd is left as an exercise for the readerThe definition of snd is trivial; writing down its type is a worthwhile exercise.

), along with a type of non-dependent pairs, corresponding to logical conjunction (and).

fst : ∀ {A B} → Σ A B → A
fst (a , _) = a

infixr 3 _×_
_×_ : (A B : Set) → Set
A × B = Σ A (λ _ → B)

Finally, we define a disjoint (tagged) union type corresponding to logical disjunction (or).

infixr 2 _⊎_
data _⊎_ (A B : Set) : Set where
  inj₁ : A → A ⊎ B
  inj₂ : B → A ⊎ B

Equality

Next, we write down the standard equality (aka identity, aka path) type, with a single constructor refl that witnesses when its two arguments are identical.It still seems somewhat magical to me that this seemingly too-simple definition encapsulates everything we want in an equality relation (well, almost everything).

We also define a convenient synonym for inequality.

infix 4 _≡_
data _≡_ (a : A) : A → Set where
  refl : a ≡ a

_≢_ : A → A → Set
x ≢ y = ¬ (x ≡ y)

Besides reflexivity, equality enjoys various properties that we will need: symmetry, transitivity, and congruence (i.e., we can apply any function to both sides of an equation).

sym : {x y : A} → x ≡ y → y ≡ x
sym refl = refl

trans : {x y z : A} → x ≡ y → y ≡ z → x ≡ z
trans refl y≡z = y≡z

cong : (f : A → B) → {x y : A} → x ≡ y → f x ≡ f y
cong _ refl = refl

Since we will spend a good amount of time reasoning about equality, it is worthwhile building up some machinery for writing more readable equality proofs. Instead of writing, say,

trans p (trans q (trans (sym r) s))

we will be able to instead write equality proofs like so:

begin
  v      ≡[ p ⟩≡
  w      ≡[ q ⟩≡
  x      ≡⟨ r ]≡
  y      ≡[ s ⟩≡
  z      ∎

The intention is that this proof shows v ≡ z, by first using p to show that v ≡ w, then q to show w ≡ x, and so on. This notation is one of my favorite applications of Agda’s mixfix operator syntax, and has several benefits:

• We can avoid nested parentheses when chaining uses of transitivity.
• We can automatically apply symmetry by using a left-pointing instead of right-pointing operator.
• We get to explicitly mention (and have Agda check for us) all the intermediate values, making it easier to write the proof incrementally, and much easier for humans to read.

This is one of the places where I deliberately chose different operator names than the standard library, which uses _≡⟨_⟩_ and _≡⟨_⟨_. The operator names I decided to use are inspired by Conor McBride. I just like the way they look better.

infix 1 begin_
begin_ : {x y : A} → x ≡ y → x ≡ y
begin x≡y = x≡y

infixr 2 _≡[_⟩≡_
_≡[_⟩≡_ : (x : A) → {y z : A} → (x ≡ y) → (y ≡ z) → (x ≡ z)
_ ≡[ x≡y ⟩≡ y≡z = trans x≡y y≡z

infixr 2 _≡⟨_]≡_
_≡⟨_]≡_ : (x : A) → {y z : A} → (y ≡ x) → (y ≡ z) → (x ≡ z)
_ ≡⟨ y≡x ]≡ y≡z = trans (sym y≡x) y≡z

infixr 5 _∎
_∎ : (x : A) → x ≡ x
_ ∎ = refl

Finally, a few Applicative-like operators for more conveniently writing common forms of congruence. For example, instead of writing cong f x≡y, we can write f $≡ x≡y; or to use congruence on both arguments of a two-place function at once, we can write f $≡ x≡y ≡$≡ z≡w. (These operators were also inspired by Conor.)

infixl 4 _$≡_
_$≡_ : (f : A → B) → {x y : A} → x ≡ y → f x ≡ f y
f $≡ x≡y = cong f x≡y

infixl 4 _≡$_
_≡$_ : {f g : A → B} → f ≡ g → (x : A) → f x ≡ g x
f≡g ≡$ x = cong (λ h → h x) f≡g

infixl 4 _≡$≡_
_≡$≡_ : {f g : A → B} → f ≡ g → {x y : A} → x ≡ y → f x ≡ g y
f≡g ≡$≡ x≡y = trans (f≡g ≡$ _) (_ $≡ x≡y)

Natural numbers

Of course, we will need a type to represent the natural numbers. We can also tell Agda that our natural number type should correspond to its built-in notion of natural numbers, so we can use numeric literals like 2 : ℕ instead of having to write suc (suc zero).

data ℕ : Set where
  zero : ℕ
  suc : ℕ → ℕ
{-# BUILTIN NATURAL ℕ #-}

NoConf : ℕ → ℕ → Set
NoConf zero zero = ⊤
NoConf zero (suc n) = ⊥
NoConf (suc m) zero = ⊥
NoConf (suc m) (suc n) = m ≡ n

noConf : {m n : ℕ} → m ≡ n → NoConf m n
noConf {zero} refl = tt
noConf {suc m} refl = refl

data Dec (P : Set) : Set where
  yes : P → Dec P
  no : ¬ P → Dec P

_≟_ : (x y : ℕ) → Dec (x ≡ y)
zero ≟ zero = yes refl
zero ≟ suc y = no noConf
suc x ≟ zero = no noConf
suc x ≟ suc y with x ≟ y
... | yes x≡y = yes (suc $≡ x≡y)
... | no x≢y = no (λ sx≡sy → x≢y (noConf sx≡sy))

Addition

We next turn to defining addition (by pattern-matching on the left-hand argument), along with several properties of addition we will need: zero is a right identity for addition; we can pull out a suc from the right-hand argument; and addition is commutative, associative, and left-cancellable.

infixl 6 _+_
_+_ : ℕ → ℕ → ℕ
zero + y = y
suc x + y = suc (x + y)

_+0 : (n : ℕ) → (n + 0 ≡ n)
zero +0 = refl
(suc n) +0 = suc $≡ (n +0)

_+suc_ : (x y : ℕ) → (x + suc y) ≡ suc (x + y)
zero +suc y = refl
(suc x) +suc y = suc $≡ (x +suc y)

+-comm : (x y : ℕ) → x + y ≡ y + x
+-comm zero y = sym (y +0)
+-comm (suc x) y = trans (suc $≡ (+-comm x y)) (sym (y +suc x))

+-assoc : (x y z : ℕ) → (x + y) + z ≡ x + (y + z)
+-assoc zero y z = refl
+-assoc (suc x) y z = suc $≡ (+-assoc x y z)

+-cancelˡ : (x y z : ℕ) → x + y ≡ x + z → y ≡ z
+-cancelˡ zero y z x+y≡x+z = x+y≡x+z
+-cancelˡ (suc x) y z x+y≡x+z = +-cancelˡ x y z (noConf x+y≡x+z)

Multiplication

Multiplication is next: we start by defining the multiplication operation (by pattern-matching on the left-hand argument) and proving a few lemmas about multiplying by known arguments on the right. The proof of *suc is the most involved proof we have seen yet, but it ultimately just comes down to algebra, and we can make good use of our notation for writing chained equality proofs.

infixl 7 _*_
_*_ : ℕ → ℕ → ℕ
zero * y = zero
suc x * y = y + x * y

_*0 : (n : ℕ) → (n * 0 ≡ 0)
zero *0 = refl
(suc n) *0 = n *0

_*1 : (n : ℕ) → (n * 1 ≡ n)
0 *1 = refl
(suc n) *1 = suc $≡ (n *1)

_*suc_ : (x y : ℕ) → (x * suc y ≡ x + x * y)
zero *suc y = refl
(suc x) *suc y = suc $≡ (
  begin
  y + x * suc y               ≡[ (y +_) $≡ (x *suc y) ⟩≡
  y + (x + x * y)             ≡⟨ +-assoc y x (x * y) ]≡
  (y + x) + x * y             ≡[ _+_ $≡ +-comm y x ≡$ x * y ⟩≡
  (x + y) + x * y             ≡[ +-assoc x _ _ ⟩≡
  x + (y + x * y)             ∎)

We prove some standard properties of multiplication: commutativity, distributivity over addition, associativity. Again, the proofs mostly consist of a whole bunch of algebra, using the special notation for building chained equality proofs.

*-comm : (x y : ℕ) → x * y ≡ y * x
*-comm zero y = sym (y *0)
*-comm (suc x) y = begin
  y + x * y                   ≡[ y +_ $≡ *-comm x y ⟩≡
  y + y * x                   ≡⟨ y *suc x ]≡
  y * suc x                   ∎

*-distribˡ : (x y z : ℕ) → x * (y + z) ≡ x * y + x * z
*-distribˡ zero y z = refl
*-distribˡ (suc x) y z = begin
  y + z + x * (y + z)         ≡[ (y + z) +_ $≡ *-distribˡ x y z ⟩≡
  y + z + (x * y + x * z)     ≡[ +-assoc y _ _ ⟩≡
  y + (z + (x * y + x * z))   ≡⟨ y +_ $≡ +-assoc z _ _ ]≡
  y + ((z + x * y) + x * z)   ≡[ y +_ $≡ (_+_ $≡ +-comm z _ ≡$ x * z) ⟩≡
  y + ((x * y + z) + x * z)   ≡[ y +_ $≡ +-assoc (x * y) _ _ ⟩≡
  y + (x * y + (z + x * z))   ≡⟨ +-assoc y _ _ ]≡
  y + x * y + (z + x * z)     ∎

*-distribʳ : (x y z : ℕ) → (x + y) * z ≡ x * z + y * z
*-distribʳ x y z = begin
  (x + y) * z                 ≡[ *-comm (x + y) _ ⟩≡
  z * (x + y)                 ≡[ *-distribˡ z _ _ ⟩≡
  z * x + z * y               ≡[ _+_ $≡ *-comm z _ ≡$≡ *-comm z _ ⟩≡
  x * z + y * z               ∎

*-assoc : (x y z : ℕ) → (x * y) * z ≡ x * (y * z)
*-assoc zero y z = refl
*-assoc (suc x) y z = begin
  (y + x * y) * z             ≡[ *-distribʳ y _ _ ⟩≡
  y * z + (x * y) * z         ≡[ y * z +_ $≡ *-assoc x _ _ ⟩≡
  y * z + x * (y * z)         ∎

Finally, we prove that multiplication is left-cancellative. This proof is somewhat tricky—in the case that x, y, and z are all successors, we need to use the induction hypothesis (i.e. a recursive call to *-cancelˡ) on x and the predecessors of y and z, using the fact that + is left-cancellative to construct the required input equality.

*-cancelˡ : (x y z : ℕ) → (0 ≢ x) → x * y ≡ x * z → y ≡ z
*-cancelˡ zero y z x≢0 xy≡xz = absurd (x≢0 refl)
*-cancelˡ (suc x) zero zero x≢0 xy≡xz = refl
*-cancelˡ (suc x) zero (suc z) x≢0 xy≡xz = absurd (noConf (trans (sym (x *0)) xy≡xz))
*-cancelˡ (suc x) (suc y) zero x≢0 xy≡xz = absurd (noConf (trans xy≡xz (x *0)))
*-cancelˡ (suc x) (suc y) (suc z) x≢0 xy≡xz = suc $≡
  ( *-cancelˡ (suc x) y z x≢0
    ( +-cancelˡ (suc x) (suc x * y) (suc x * z)
      ( begin
          suc x + suc x * y   ≡⟨ (suc x) *suc y ]≡
          suc x * suc y       ≡[ xy≡xz ⟩≡
          suc x * suc z       ≡[ (suc x) *suc z ⟩≡
          suc x + suc x * z   ∎
      )
    )
  )

Inequality

Next, we give a standard definition of the “less than or equal to” relation on natural numbers. Note that the structure of a proof of \(x \leq y\) exactly matches the structure of \(x\) itself.

data _≤_ : ℕ → ℕ → Set where
  zle : {n : ℕ} → zero ≤ n
  sle : {m n : ℕ} → m ≤ n → suc m ≤ suc n

We also prove some standard properties of \(\leq\): it is reflexive and transitive, and is related to suc in various ways.

≤-refl : {m : ℕ} → m ≤ m
≤-refl {zero} = zle
≤-refl {suc m} = sle ≤-refl

≤-trans : {x y z : ℕ} → x ≤ y → y ≤ z → x ≤ z
≤-trans zle y≤z = zle
≤-trans (sle x≤y) (sle y≤z) = sle (≤-trans x≤y y≤z)

≤-sucr : {m n : ℕ} → m ≤ n → m ≤ suc n
≤-sucr zle = zle
≤-sucr (sle m≤n) = sle (≤-sucr m≤n)

≤-sucl : {m n : ℕ} → suc m ≤ n → m ≤ n
≤-sucl (sle sm≤n) = ≤-sucr sm≤n

≤-pred : {x y : ℕ} → suc x ≤ suc y → x ≤ y
≤-pred (sle sx≤sy) = sx≤sy

For convenience, we define \(<\) in terms of \(\leq\), and prove a few properties: any number is less than its successor, and \(<\) is transitive and non-reflexive.

_<_ : ℕ → ℕ → Set
x < y = suc x ≤ y

_<suc : (x : ℕ) → x < suc x
_<suc zero = sle zle
_<suc (suc x) = sle (x <suc)

<-trans : {x y z : ℕ} → x < y → y < z → x < z
<-trans (sle x<y) (sle y<z) = ≤-trans (sle x<y) (≤-sucr y<z)

x≮x : {x : ℕ} → ¬ (x < x)
x≮x {zero} = λ ()
x≮x {suc x} = λ { (sle x<x) → x≮x x<x}

≡→≤ : {x y : ℕ} → x ≡ y → x ≤ y
≡→≤ refl = ≤-refl

<→≢ : {x y : ℕ} → x < y → x ≢ y
<→≢ x<y refl = x≮x x<y

<→≱ : {x y : ℕ} → x < y → ¬ (y ≤ x)
<→≱ (sle x<y) (sle y≤x) = <→≱ x<y y≤x

≤≢→< : {x y : ℕ} → x ≤ y → x ≢ y → x < y
≤≢→< {y = zero} zle x≢y = absurd (x≢y refl)
≤≢→< {y = suc y} zle x≢y = sle zle
≤≢→< (sle x≤y) x≢y = sle (≤≢→< x≤y (λ m≡n → x≢y (suc $≡ m≡n)))

≤-<-trans : {x y z : ℕ} → x ≤ y → y < z → x < z
≤-<-trans x≤y (sle y<z) = ≤-trans (sle x≤y) (sle y<z)

<-≤-trans : {x y z : ℕ} → x < y → y ≤ z → x < z
<-≤-trans (sle x<y) y≤z = ≤-trans (sle x<y) y≤z

¬01-is-≥2 : (a : ℕ) → (a ≢ 0) → (a ≢ 1) → (2 ≤ a)
¬01-is-≥2 zero a≢0 a≢1 = absurd (a≢0 refl)
¬01-is-≥2 (suc zero) a≢0 a≢1 = absurd (a≢1 refl)
¬01-is-≥2 (suc (suc a)) a≢0 a≢1 = sle (sle zle)

≤+ : {x y : ℕ} → x ≤ (x + y)
≤+ {zero} = zle
≤+ {suc x} = sle ≤+

≤* : {x y : ℕ} → (x ≢ 0) → y ≤ (x * y)
≤* {zero} x≢0 = absurd (x≢0 refl)
≤* {suc x} x≢0 = ≤+

+→≤ : {x y z : ℕ} → x + y ≡ z → x ≤ z
+→≤ refl = ≤+

+→< : {x y z : ℕ} → 0 < y → x + y ≡ z → x < z
+→< {x} {suc y} _ x+y≡z = +→≤ (trans (sym (x +suc y)) x+y≡z)

*→≤ : {x y z : ℕ} → (y ≢ 0) → y * x ≡ z → x ≤ z
*→≤ {x} {y} y≢0 refl = ≤* y≢0

Divisibility, primes, and composites

With the preliminaries out of the way, we can finally get on with the meat of the problem—and we finally get to make use of a dependent pair! A constructive proof that a divides b is a specific natural number witness k, along with a proof that k * a ≡ b.

_∣_ : ℕ → ℕ → Set
a ∣ b = Σ ℕ (λ k → k * a ≡ b)

Proofs of divisibility are unique—that is, for given \(a\) and \(b\) there is at most one value of \(k\) such that \(ka = b\). We won’t need this, but it follows easily from the fact that multiplication is cancellative. More interesting is the fact that divisibility is decidable—that is, for given numbers \(a\) and \(b\) we can calculate either a proof that \(a \mid b\), or a proof that \(\neg (a \mid b)\). This will play a starring role later on—to factor a number we need to be able to try potential divisors and find out whether they work—but proving it is not easy! It will take us several hundred more lines of Agda to get there.

In any case, using this notion of divisibility, we can now define prime and composite numbers. A number \(n\) is defined to be prime if it is at least two, and every \(2 \leq d < n\) does not divide \(n\).

Prime : ℕ → Set
Prime n = (2 ≤ n) × (∀ (d : ℕ) → (d < n) → (2 ≤ d) → ¬ (d ∣ n))

One could equivalently define primality by saying that any divisor of \(n\) must be equal to \(1\) or \(n\); I just decided I liked this formulation better, especially because it directly matches up with the way we will test a number for primality later.

A composite number is one that has a nontrivial divisor—that is, a number \(d\) such that \(2 \leq d < n\) and \(d\) divides \(n\).Note that we could easily prove that if \(n\) is prime then \(n\) is not composite, and likewise if \(n\) is composite then it is not prime, but we won’t end up needing these lemmas.

Composite : ℕ → Set
Composite n = Σ ℕ (λ d → 2 ≤ d × d < n × d ∣ n)

Unlike proofs of divisibility, proofs of Composite n are not unique. For example, we could prove Composite 12 by showing that \(2\) is a nontrivial divisor of \(12\), or by showing that \(3\) is. Although this does not matter from a purely logical point of view, it matters computationally; in general, we care which specific proof of Composite n we have.

FactorsOf : ℕ → Set
FactorsOf n = Σ (Composite n × Composite n) (λ {(f₁ , f₂) → fst f₁ * fst f₂ ≡ n})

factorsOf : (n : ℕ) → Composite n → FactorsOf n
factorsOf n (a , 2≤a , a<n , b , ba≡n) =

  ((b , 2≤b , b<n , a , trans (*-comm a b) ba≡n) , (a , 2≤a , a<n , b , ba≡n)) , ba≡n

 where
  0<n : 0 < n
  0<n = <-trans (sle zle) (<-trans 2≤a a<n)

  2≤b : 2 ≤ b
  2≤b = ¬01-is-≥2 b

    (λ b≡0 → <→≢ 0<n
      (begin
        0                     ≡[ refl ⟩≡
        0 * a                 ≡⟨ _*_ $≡ b≡0 ≡$ a ]≡
        b * a                 ≡[ ba≡n ⟩≡
        n                     ∎
      )
    )

    (λ b≡1 → <→≢ a<n
      (begin
        a                     ≡⟨ a *1 ]≡
        a * 1                 ≡[ *-comm a 1 ⟩≡
        1 * a                 ≡⟨ _*_ $≡ b≡1 ≡$ a ]≡
        b * a                 ≡[ ba≡n ⟩≡
        n                     ∎
      )
    )

  b<n : b < n
  b<n = ≤≢→<

    (*→≤ (λ a≡0 → <→≢ (<-trans (sle zle) 2≤a) (sym a≡0)) (trans (*-comm a b) ba≡n))

    (λ b≡n → <→≢ 2≤a
      (sym
        (*-cancelˡ n a 1 (<→≢ 0<n)
          (begin
            n * a             ≡⟨ _*_ $≡ b≡n ≡$ a ]≡
            b * a             ≡[ ba≡n ⟩≡
            n                 ≡⟨ n *1 ]≡
            n * 1             ∎
          )
        )
      )
    )

Division

Let’s start working our way towards proving that divisibility is decidable. To check whether \(d \mid n\), the usual idea would be to divide \(n\) by \(d\) and check whether we get a remainder of zero. So we need to formalize this notion of division with remainder.

Specifically, when we divide \(n\) by \(d\), we expect to get a quotient \(q\) and a remainder \(r\), such that \(r + qd = n\), and \(0 \leq r < d\). The first condition, \(r + qd = n\), just defines what we mean by division: \(n\) is \(q\) times \(d\), plus a remainder of \(r\). The second condition will ensure that the result is unique. We wouldn’t want to divide \(17\) by \(2\) and end up with a quotient of \(6\) and a remainder of \(5\); the remainder should be as small as possible.

The DivMod type simply encodes these requirements.

data DivMod (n d q r : ℕ) : Set where
  DM : (r + q * d ≡ n) → (r < d) → DivMod n d q r

We can prove a few lemmas about DivMod. First, whenever we have DivMod n d q r, then d must be positive, since \(r < d\) and \(r\) is a natural number.

divMod→0<d : {n d q r : ℕ} → DivMod n d q r → 0 < d
divMod→0<d (DM _ r<d) = ≤-<-trans zle r<d

We can also show that for nonzero \(d\), the remainder is zero if and only if \(d \mid n\):

mod0→divides : (n d : ℕ) {q : ℕ} → DivMod n d q 0 → d ∣ n
mod0→divides n d {q} (DM eq _) = q , eq

divides→mod0 : (n d : ℕ) → (0 < d) → d ∣ n → Σ ℕ (λ q → DivMod n d q 0)
divides→mod0 n d 0<d (q , qd≡n) = q , (DM qd≡n 0<d)

We would also like to show that if the remainder when dividing \(n\) by \(d\) is not zero, then \(d\) does not divide \(n\). This is almost the contrapositive of divides→mod0—which would be trivial to show—but not quite: I said “the” remainder, but actually we don’t yet know that the quotient and remainder are unique! Perhaps we could get a remainder of 0 and some other remainder for the same \(n\) and \(d\), by choosing different quotients?

Of course, quotients and remainders are unique: that is, if \(q_1, r_1\) and \(q_2, r_2\) both satisfy the properties to be the quotient and remainder of \(n\) divided by \(d\), then in fact \(q_1 = q_2\) and \(r_1 = r_2\). But how can we prove this? The usual idea is to look at the difference \(r_1 - r_2 = dq_1 - dq_2\), which is divisible by \(d\); but since \(r_1 < d\) and \(r_2 < d\), the only way for the difference \(r_1 - r_2\) to be divisible by \(d\) is if in fact \(r_1 - r_2 = 0\). From here we can also derive \(q_1 = q_2\) via algebra.

Subtraction, eh? In order to formalize this, it seems as though we might need to define the integers… but there is a better way!

Absolute difference

The previous informal argument mentioned the difference \(r_1 - r_2\). But we could just as easily have talked about \(r_2 - r_1\) instead, and the same argument would work just as well. This observation shows that we do not actually care about the (signed) difference between \(r_1\) and \(r_2\), but only the distance between them. This means we can just stick to our well-loved natural numbers, and define a commutative absolute difference function which computes the nonnegative distance between its two arguments, like so:

∥_-_∥ : ℕ → ℕ → ℕ
∥ zero - y ∥ = y
∥ suc x - zero ∥ = suc x
∥ suc x - suc y ∥ = ∥ x - y ∥

Of course, we will need a lot of small lemmas about the properties of this operation. We can start by proving that the distance between two numbers is 0 if and only if they are equal:

diff0 : (x : ℕ) → 0 ≡ ∥ x - x ∥
diff0 zero = refl
diff0 (suc x) = diff0 x

diff0→≡ : {x y : ℕ} → 0 ≡ ∥ x - y ∥ → x ≡ y
diff0→≡ {zero} {zero} eq = eq
diff0→≡ {suc x} {suc y} eq = suc $≡ diff0→≡ eq

Next, the distance between any number and 0 is the number itself, and the distance function is commutative.

∥x-0∥≡x : (x : ℕ) → ∥ x - 0 ∥ ≡ x
∥x-0∥≡x zero = refl
∥x-0∥≡x (suc x) = refl

diff-comm : {x y : ℕ} → ∥ x - y ∥ ≡ ∥ y - x ∥
diff-comm {zero} {zero} = refl
diff-comm {zero} {suc y} = refl
diff-comm {suc x} {zero} = refl
diff-comm {suc x} {suc y} = diff-comm {x} {y}

A key lemma supporting the argument outlined in the previous section is that if \(x\) and \(y\) are both less than \(d\), so is their absolute difference.

diff-< : {x y d : ℕ} → x < d → y < d → ∥ x - y ∥ < d
diff-< {zero} {y} x<d y<d = y<d
diff-< {suc x} {zero} x<d y<d = x<d
diff-< {suc x} {suc y} x<d y<d = diff-< {x} {y} (<-trans (x <suc) x<d) (<-trans (y <suc) y<d)

We can also cancel the same thing being added to both sides, or factor out the same thing being multiplied on both sides.

diff-cancelˡ : (a b c : ℕ) → ∥ (a + b) - (a + c) ∥ ≡ ∥ b - c ∥
diff-cancelˡ zero b c = refl
diff-cancelˡ (suc a) b c = diff-cancelˡ a b c

diff-distribʳ : (x y d : ℕ) → ∥ x * d - y * d ∥ ≡ ∥ x - y ∥ * d
diff-distribʳ zero y d = refl
diff-distribʳ (suc x) zero d = ∥x-0∥≡x (d + x * d)
diff-distribʳ (suc x) (suc y) d = begin
  ∥ (d + x * d) - (d + y * d) ∥         ≡[ diff-cancelˡ d (x * d) (y * d) ⟩≡
  ∥ x * d - y * d ∥                     ≡[ diff-distribʳ x y d ⟩≡
  ∥ x - y ∥ * d                         ∎

Another key lemma is that if \(w + x = y + z\), then \(\|w - y\| = \|x - z\|\) (sub₂ below). Personally, I found this quite tricky to prove. The best approach I found was to first prove the simpler lemma that \(x + y = z\) implies \(x = \| z - y \|\) (sub₁), which can then be used in several places in the proof of sub₂.

sub₁ : {x y z : ℕ} → x + y ≡ z → x ≡ ∥ z - y ∥
sub₁ {zero} {y} {z} refl = diff0 y
sub₁ {suc x} {zero} {suc z} x+y≡z =
  begin
    suc x                     ≡⟨ suc $≡ x +0 ]≡
    suc (x + 0)               ≡[ x+y≡z ⟩≡
    suc z                     ∎
sub₁ {suc x} {suc y} {suc z} x+y≡z =
  sub₁ {suc x} {y} {z}
    (noConf (trans (suc $≡ sym (x +suc y)) x+y≡z))

sub₂ : {w x y z : ℕ} → w + x ≡ y + z → ∥ w - y ∥ ≡ ∥ x - z ∥
sub₂ {zero} {x} {y} {z} w+x≡y+z = sub₁ (sym w+x≡y+z)
sub₂ {suc w} {x} {zero} {z} w+x≡y+z = trans (sub₁ w+x≡y+z) (diff-comm {z})
sub₂ {suc w} {x} {suc y} {z} w+x≡y+z = sub₂ {w} (noConf w+x≡y+z)

Quotient and remainder are unique

We can now return to prove that quotient and remainder are unique. First, we show that zero is the only multiple of \(d\) which is less than \(d\).

∣<→0 : {d x : ℕ} → d ∣ x → x < d → 0 ≡ x
∣<→0 (zero , ad≡x) x<d = ad≡x
∣<→0 (suc a , ad≡x) x<d = absurd (<→≱ x<d (+→≤ ad≡x))

And now for the main event: if we have both DivMod n d q₁ r₁ and DivMod n d q₂ r₂, then in fact the qs and rs must be the same.

divModUnique : {n d q₁ r₁ q₂ r₂ : ℕ} → DivMod n d q₁ r₁ → DivMod n d q₂ r₂ → (q₁ ≡ q₂) × (r₁ ≡ r₂)
divModUnique {n} {d} {q₁} {r₁} {q₂} {r₂} dm@(DM r₁+q₁d≡n r₁<d) (DM r₂+q₂d≡n r₂<d) = q₁≡q₂ , r₁≡r₂
 where

Since \(r_1 + q_1d = n\) and \(r_2 + q_2d = n\), by transitivity and symmetry we have \(r_1 + q_1d = r_2 + q_2d\); then by the sub₂ lemma, \(\|r_1 - r_2\| = \|q_1d - q_2d\|\).

  rem-diff : ∥ r₁ - r₂ ∥ ≡ ∥ q₁ * d - q₂ * d ∥
  rem-diff = sub₂ {r₁} (trans r₁+q₁d≡n (sym r₂+q₂d≡n))

Next, we can show that \(d\) divides the absolute difference \(\|r_1 - r_2\|\), by factoring it out of \(\|q_1 d - q_2 d\|\).

  d∣r₁-r₂ : d ∣ ∥ r₁ - r₂ ∥
  d∣r₁-r₂ = ∥ q₁ - q₂ ∥ ,
    (begin
      ∥ q₁ - q₂ ∥ * d         ≡⟨ diff-distribʳ q₁ q₂ d ]≡
      ∥ q₁ * d - q₂ * d ∥     ≡⟨ rem-diff ]≡
      ∥ r₁ - r₂ ∥             ∎
    )

We can then put three lemmas together to conclude \(r_1 = r_2\): first, since \(r_1\) and \(r_2\) are both less than \(d\), so is their absolute difference; since \(d\) also divides the absolute difference, the absolute difference must be zero; and finally, an absolute difference of zero means \(r_1\) and \(r_2\) must be equal.

  r₁≡r₂ : r₁ ≡ r₂
  r₁≡r₂ = diff0→≡ (∣<→0 d∣r₁-r₂ (diff-< r₁<d r₂<d))

From here, proving \(q_1 = q_2\) just requires some algebra.

  dq₁≡dq₂ : d * q₁ ≡ d * q₂
  dq₁≡dq₂ = +-cancelˡ r₁ (d * q₁) (d * q₂)
    (begin
      r₁ + d * q₁             ≡[ r₁ +_ $≡ *-comm d q₁ ⟩≡
      r₁ + q₁ * d             ≡[ r₁+q₁d≡n ⟩≡
      n                       ≡⟨ r₂+q₂d≡n ]≡
      r₂ + q₂ * d             ≡[ _+_ $≡ sym r₁≡r₂ ≡$≡ *-comm q₂ d ⟩≡
      r₁ + d * q₂             ∎
    )

  q₁≡q₂ : q₁ ≡ q₂
  q₁≡q₂ = *-cancelˡ d q₁ q₂ (<→≢ (divMod→0<d dm)) dq₁≡dq₂

Finally, we can use uniqueness of quotients and remainders to show the lemma we wanted about divisibility and remainders: if \(n\) divided by \(d\) has some nonzero number as remainder, then \(d\) does not divide \(n\). If \(d\) did divide \(n\), then we know we would get a remainder of \(0\); but since remainders are unique, we can’t have both a zero and nonzero remainder.

modS→¬divides : (n d : ℕ) {q r : ℕ} → DivMod n d q (suc r) → ¬ (d ∣ n)
modS→¬divides n d dm d∣n with divides→mod0 n d (divMod→0<d dm) d∣n
... | q₂ , dm₂ with divModUnique dm dm₂
... | q₁≡q₂ , ()

The division algorithm, take 1

So, given natural numbers \(n\) and \(d\), how do we compute the quotient and remainder? We can write down a type DivAlg that expresses what we want: given some \(n\) and \(d\), DivAlg n d represents the result of the division algorithm, that is, a pair of numbers \((q,r)\) such that DivMod n d q r holds.

DivAlg : ℕ → ℕ → Set
DivAlg n d = Σ (ℕ × ℕ) (λ { (q , r) → DivMod n d q r })

Then we want a function with a type something like (n d : ℕ) → DivAlg n d (actually this type is not quite correct—can you see why?). How can we write something with this type?

One simple idea, expressed imperatively, is to start with \(q = 0\). Now, as long as \(n \geq d\), subtract \(d\) from \(n\) and add one to \(q\)—if we can find \(q\) and \(r\) such that \(r + qd = n - d\), then \(r + (q+1)d = n\). Eventually, \(n\) must land in the range \(0 \leq n < d\), in which case it will be the remainder, and the current value of \(q\) will be the quotient.

data Cmp (n d : ℕ) : Set where
  LT : n < d → Cmp n d
  GE : (n′ : ℕ) → (n′ + d ≡ n) → Cmp n d

_decreaseBy?_ : (n d : ℕ) → Cmp n d
zero decreaseBy? zero = GE 0 refl
zero decreaseBy? suc d = LT (sle zle)
suc n decreaseBy? zero = GE (suc n) ((suc n) +0)
suc n decreaseBy? suc d with n decreaseBy? d
... | LT n<d = LT (sle n<d)
... | GE n′ n′+d≡n = GE n′ (trans (n′ +suc d) (suc $≡ n′+d≡n))

incDivMod : {n′ n d q r : ℕ} → n′ + d ≡ n → DivMod n′ d q r → DivMod n d (suc q) r
incDivMod {n′} {n} {d} {q} {r} n′+d≡n (DM r+qd≡n′ r<d) = DM r+d+qd≡n r<d
 where
  r+d+qd≡n : r + (d + q * d) ≡ n
  r+d+qd≡n = begin
    r + (d + q * d)           ≡⟨ +-assoc r _ _ ]≡
    (r + d) + q * d           ≡[ _+_ $≡ +-comm r _ ≡$ q * d ⟩≡
    (d + r) + q * d           ≡[ +-assoc d _ _ ⟩≡
    d + (r + q * d)           ≡[ d +_ $≡ r+qd≡n′ ⟩≡
    d + n′                    ≡[ +-comm d _ ⟩≡
    n′ + d                    ≡[ n′+d≡n ⟩≡
    n                         ∎

module DivModBad where

  {-# NON_TERMINATING #-}
  divAlg : (n d : ℕ) → DivAlg n d
  divAlg n d with n decreaseBy? d
  ... | LT n<d = (0 , n) , (DM (n +0) n<d)
  ... | GE n′ n′+d≡n with divAlg n′ d
  ... | (q , r) , dm = (suc q , r) , (incDivMod n′+d≡n dm)

Well-founded induction

Normally, Agda only allows functions that are structurally recursive—that is, functions which make recursive calls on syntactic subterms of their inputs. (Agda’s termination checking is a bit more sophisticated than that, but that’s the basic idea.) However, we can use basic structural induction to bootstrap our way into more exotic forms. In particular, we are going to define something called well-founded induction.Note that I will use the terms “recursion” and “induction” more or less interchangeably. In some contexts, people make a distinction between the terms (typically a recursion principle is a less-dependently-typed version of an induction principle), but in this context, inductive proofs correspond, via Curry-Howard, to (suitably restricted) recursive functions, so “induction” and “recursion” describe the same thing from a logical and computational viewpoint, respectively.

The idea of well-founded induction starts with the general idea of a relation. A relation on A is just a function that takes two values of type A and produces a type, representing evidence that the two values are related (according to whatever kind of relationship we have in mind).

Rel : Set → Set₁
Rel A = A → A → Set

We have already seen quite a few relations, such as equality, \(<\), \(\leq\), and divisibility.

Suppose we’re writing a recursive function, with some relation \(\prec\) in mind, and for a given input \(x\) we’re only allowed to make recursive calls on values \(y\) such that \(y \prec x\). If \(\prec\) is the “is a syntactic subterm of” relation, then we get structural recursion as usual. But what if \(\prec\) is some other relation? What needs to be true about \(\prec\) for this to make sense? In particular, how can we be sure that the function won’t get stuck in infinite recursion?

One’s first instinct might be to say that \(y \prec x\) needs to imply that \(y\) is “smaller than” \(x\) somehow. But what does “smaller than” mean? And in fact, “smaller than” doesn’t always work: for example, if we are writing a function over the rational numbers, or even just the integers, the usual “smaller than” relation does not guarantee our function will terminate; it’s possible to continue choosing smaller and smaller rational numbers or integers forever.

The key idea is exactly that this can’t happen: it’s not possible to have an infinite chain of values where each is related to the previous. That is, there should be no left-infinite chains \(\dots \prec y_3 \prec y_2 \prec y_1 \prec x\). Then we are guaranteed that if we keep making recursive calls on values that are related by \(\prec\) to the previous value, we will have to stop eventually: after some finite number of calls we will hit a value with nothing else related to it.

A relation \(\prec\) with this “no left-infinite chains” property is called well-founded. But how do we encode this idea in Agda?

data Acc (_≺_ : Rel A) : A → Set where
  acc : {x : A} → ((y : A) → y ≺ x → Acc _≺_ y) → Acc _≺_ x

WellFounded : Rel A → Set
WellFounded {A} _≺_ = (a : A) → Acc _≺_ a

wf-ind :
  {P : A → Set}

  {_≺_ : Rel A} →

  WellFounded _≺_ →

  ((y : A) → ((z : A) → z ≺ y → P z) → P y) →

  (x : A) → P x

module WFIndBad where

  {-# NON_TERMINATING #-}
  wf-ind-bad : {P : A → Set} {_≺_ : Rel A} → WellFounded _≺_ → ((y : A) → ((z : A) → z ≺ y → P z) → P y) → (x : A) → P x
  wf-ind-bad wf ind x = ind x (λ z Rzx → wf-ind-bad wf ind z)

wf-ind {A} {P} {_≺_} wf ind x = go x (wf x)
 where
  go : (x : A) → Acc _≺_ x → P x
  go x (acc f) = ind x (λ z z≺x → go z (f z z≺x))

↓ : (ℕ → Set) → (ℕ → Set)
↓ P n = (k : ℕ) → (k < n) → P k

<-acc : (m : ℕ) → ↓ (Acc _<_) m
<-acc zero = λ k ()
<-acc (suc m) zero (sle le) = acc (λ y ())
<-acc (suc m) (suc k) (sle le) = acc (λ y y<sk → <-acc m y (<-≤-trans y<sk le))

<-wf : WellFounded _<_
<-wf n = <-acc (suc n) n (n <suc)

The division algorithm

Finally, we can define the division algorithm, via well-founded induction! The definition is very similar to our first attempt, but we use the principle of well-founded induction with \(<\). Note that neither divAlg nor its helper function go is directly recursive. Instead, go takes an induction hypothesis as an argument, which we call instead, providing an extra proof that the subject of the induction hypothesis is in fact less than the original input. wf-ind takes care of the actual recursion.

divAlg : (n d : ℕ) → (0 < d) → DivAlg n d
divAlg n d 0<d = wf-ind {P = λ n → DivAlg n d} <-wf go n
 where
  go : (n : ℕ) → ((n′ : ℕ) → n′ < n → DivAlg n′ d) → DivAlg n d
  go n IH with n decreaseBy? d
  ... | LT n<d = (0 , n) , DM (n +0) n<d
  ... | GE n′ n′+d≡n with IH n′ (+→< 0<d n′+d≡n)
  ... | (q , r) , dm = (suc q , r) , incDivMod n′+d≡n dm

Using the division algorithm, we can also finally decide whether one number divides another: zero divides zero; zero does not divide any successor since that would imply there is some \(k\) such that \(k\) times zero is nonzero, which is absurd; and if \(x\) is a successor, we can apply the division algorithm and check the remainder, applying some previous lemmas that say what zero and nonzero remainders tells us about divisibility.

_∣?_ : (x y : ℕ) → Dec (x ∣ y)
zero ∣? zero = yes (0 , refl)
zero ∣? (suc y) = no λ { (a , eq) → absurd (noConf (trans (sym (*-comm a zero)) eq))}
(suc x) ∣? y with divAlg y (suc x) (sle zle)
... | (q , zero) , dm = yes (mod0→divides y (suc x) dm)
... | (q , suc r) , dm = no (modS→¬divides y (suc x) dm)

Primality testing

To test a number for primality, we are just going to use straightforward, naive trial division. The straightforward way of doing this is by starting at \(2\) and counting up—but this is a problem, because when pattern-matching on natural numbers we most naturally count down.

Well, remember—build the evidence you want to pattern-match on! Let’s develop some machinery for counting up instead of down.

data _≤′_ : ℕ → ℕ → Set where
  lerefl : {n : ℕ} → n ≤′ n
  lesuc : {m n : ℕ} → suc m ≤′ n → m ≤′ n

≤′-suc : {m n : ℕ} → m ≤′ n → suc m ≤′ suc n
≤′-suc lerefl = lerefl
≤′-suc (lesuc m≤′n) = lesuc (≤′-suc m≤′n)

0≤′ : (n : ℕ) → 0 ≤′ n
0≤′ zero = lerefl
0≤′ (suc n) = lesuc (≤′-suc (0≤′ n))

≤→≤′ : {m n : ℕ} → m ≤ n → m ≤′ n
≤→≤′ {n = n} zle = 0≤′ n
≤→≤′ (sle m≤n) = ≤′-suc (≤→≤′ m≤n)

data _∈[_⋯_] : ℕ → ℕ → ℕ → Set where
  stop : {a b : ℕ} → a ≤ b → b ∈[ a ⋯ b ]
  step : {a i b : ℕ} → a ≤ i → suc i ∈[ a ⋯ b ] → i ∈[ a ⋯ b ]

loop : (a b : ℕ) → (a ≤′ b) → a ∈[ a ⋯ b ]
loop a b a≤′b = mid a a b ≤-refl a≤′b
 where
  mid : (a i b : ℕ) → (a ≤ i) → (i ≤′ b) → i ∈[ a ⋯ b ]
  mid a i b a≤i lerefl = stop a≤i
  mid a i b a≤i (lesuc i≤′b) = step a≤i (mid a (suc i) b (≤-sucr a≤i) i≤′b)

top : {i a b : ℕ} → i ∈[ a ⋯ b ] → i ≤ b
top (stop _) = ≤-refl
top (step _ s) = ≤-sucl (top s)

extend : {P : ℕ → Set} {m : ℕ} → (↓ P) m → P m → (↓ P) (suc m)
extend {m = m} soFar Pm j with (j ≟ m)
... | yes refl = λ _ → Pm
... | no j≢m = λ { (sle j≤m) → soFar j (≤≢→< j≤m j≢m) }

prime? : (n : ℕ) → (2 ≤ n) → Prime n ⊎ Composite n
prime? n 2≤n = trialDiv (loop 2 n (≤→≤′ 2≤n)) noDivisorsUpTo2
 where
  NoDivisorsUpTo : ℕ → Set
  NoDivisorsUpTo = ↓ (λ # → (2 ≤ #) → ¬ (# ∣ n))

  noDivisorsUpTo2 : NoDivisorsUpTo 2
  noDivisorsUpTo2 (suc zero) _ (sle ()) _
  noDivisorsUpTo2 (suc (suc j)) (sle (sle ())) _ _

  trialDiv : {m : ℕ} → m ∈[ 2 ⋯ n ] → NoDivisorsUpTo m → Prime n ⊎ Composite n
  trialDiv (stop 2≤n) soFar = inj₁ (2≤n , soFar)
  trialDiv {m} (step 2≤m next) soFar with m ∣? n
  ... | yes m∣n = inj₂ (m , 2≤m , top next , m∣n)
  ... | no pf = trialDiv next (extend soFar (λ _ → pf))

Lists

Before we are able to state the Fundamental Theorem of Arithmetic, we need to build up a data type for lists, along with some standard list manipulation functions. First, we define the type of lists and the standard foldr function.

data List (A : Set) : Set where
  [] : List A
  _∷_ : A → List A → List A

foldr : (A → B → B) → B → List A → B
foldr _&_ z [] = z
foldr _&_ z (x ∷ xs) = x & foldr _&_ z xs

Now we can define concatenation and product via foldr.

_++_ : List A → List A → List A
xs ++ ys = foldr (_∷_) ys xs

product : List ℕ → ℕ
product = foldr _*_ 1

We will need All, which expresses that some predicate holds of all the elements of a list. In fact, All is manifestly an instance of foldr as well, but we would need a universe-polymorphic version of foldr for that, so we just write it manually.

All : (P : A → Set) → List A → Set
All P [] = ⊤
All P (x ∷ xs) = P x × All P xs

Now, we just need a couple lemmas about concatenation: first, that if P holds for all the elements in xs and all the elements in ys, then it holds for all the elements in xs ++ ys; and second, that product distributes over concatenation (i.e. it is a homomorphism from the monoid of lists under concatenation to the monoid of natural numbers under multiplication).

All-++ : {P : A → Set} {xs ys : List A} → All P xs → All P ys → All P (xs ++ ys)
All-++ {xs = []} Pxs Pys = Pys
All-++ {xs = _ ∷ _} (Px , Pxs) Pys = Px , All-++ Pxs Pys

product-++ : (xs ys : List ℕ) → product (xs ++ ys) ≡ product xs * product ys
product-++ [] ys = sym (_ +0)
product-++ (x ∷ xs) ys = trans (x *_ $≡ product-++ xs ys) (sym (*-assoc x (product xs) (product ys)))

The Fundamental Theorem of Arithmetic

Finally, we can put all the pieces together to state and prove (one half of) the Fundamental Theorem of Arithmetic! FTA n says that for some positive integer n, we can find a list of natural numbers which are all prime, and whose product is n.

FTA : ℕ → Set
FTA n = Σ (List ℕ) (λ ps → All Prime ps × product ps ≡ n)

To prove that this holds for all positive integers, we can again use well-founded induction: in the base case, if \(n = 1\), the empty list suffices. Otherwise, we can decide whether \(n\) is prime. If so, the singleton list containing \(n\) fits the bill. Otherwise, \(n = ab\) where \(a\) and \(b\) are both nontrivial divisors of \(n\); by the induction hypothesis, both can be factored into primes, and the list we want for \(n\) is simply the concatenation of the factorizations for \(a\) and \(b\).

fta : (n : ℕ) → (0 < n) → FTA n
fta n = wf-ind {P = (λ n → (0 < n) → FTA n)} <-wf go n
 where
  go : (n : ℕ) → ((n′ : ℕ) → n′ < n → 0 < n′ → FTA n′) → 0 < n → FTA n
  go (suc zero) IH 0<n = [] , (tt , refl)
  go (suc (suc n)) IH 0<n with prime? (suc (suc n)) (sle (sle zle))
  ... | inj₁ P = (suc (suc n) ∷ []) , ((P , tt) , (suc $≡ (suc $≡ (n *1))))
  ... | inj₂ C with factorsOf _ C
  ... | ((a , sle _ , a<n , _) , (b , sle _ , b<n , _)) , ab≡n
      with IH a a<n (sle zle)
         | IH b b<n (sle zle)
  ... | ps₁ , Pps₁ , prod₁ | ps₂ , Pps₂ , prod₂ = (ps₁ ++ ps₂) , (All-++ Pps₁ Pps₂) ,
    begin
      product (ps₁ ++ ps₂)      ≡[ product-++ ps₁ ps₂ ⟩≡
      product ps₁ * product ps₂ ≡[ _*_ $≡ prod₁ ≡$≡ prod₂ ⟩≡
      a * b                     ≡[ ab≡n ⟩≡
      suc (suc n)               ∎

Further Directions

That concludes our tour of the Fundamental Theorem of Arithmetic in Agda! If you’ve worked through the whole thing and completed the proofs mostly on your own, congratulations! If you want more practice, there are a lot of directions you could take this:

• Doing trial division all the way up to \(n\) is silly; we can stop when we get to \(\sqrt n\). I think this would make for a nice exercise (in fact, Taneb’s version in the Agda stdlib does this).
• Define “\(d\) is a proper divisor of \(n\)” to mean that that \(d \mid n\) and \(2 \leq d < n\), then show that the “is a proper divisor of” relation is well-founded, and prove fta via well-founded induction on that relation instead. This might streamline some parts of the proof; I’m not sure.
• The other half of the FTA says that the prime factorization is unique up to permutation. To prove this, one has to define what it means for one list to be a permutation of another, and show that if there are two different prime factorizations then one must be a permutation of the other (if \(p\) is a prime from the first factorization, then it divides the other factorization as well, which means it must be equal to one of the primes in the other factorization). I may write up this proof in a follow-up post.

Disco

For the past nine (!) years I have been developing Disco, a functional teaching language for use in a discrete mathematics course. It features first-class functions, polymorphism, and recursive algebraic data types, along with various built-in mathematical niceties and syntax that is designed to be close to mathematical practice.

As a simple example, here’s a recursive function in Disco to compute the hyperbinary numbers:

h : N -> N
h(0)      = 1
h(2n)     = h(n) + h(n .- 1)
h(2n + 1) = h(n)

Since recursive functions in Disco are automatically memoized, this evaluates almost instantly even on very large numbers:

Disco> h(1000000)
1287

If you want to know more about Disco, you can read a paper about it here, or read the language documentation.

The problem

I want students in my Discrete Mathematics course (or any Discrete Mathematics course) to be able to use Disco: to play around at a REPL, write and test their own code, and so on.

However, getting students to install Haskell and build Disco from source is a total non-starter, for multiple reasons. Some students in the course are not all that tech-savvy. Some students don’t even have their own computer, or the computer they do have chokes when trying to compile a large Haskell project (e.g. because of limited memory). Even aside from those issues, I simply don’t want to spend time and effort helping students install stuff at the beginning of the semester (at least not in this class).

Old solution: Replit

For a couple years, students were able to use Disco via a site called Replit, which provided free educational accounts, and supported arbitrary Nix configurations. Since the disco package on Hackage was picked up by nixpkgs, it was possible to spin up a Disco interpreter on Replit in just a few seconds. Replit provided a virtual file system, an editor, and, of course, a REPL.

This was a great solution while it lasted, but sadly it is no longer viable:

• Disco has been broken in nixpkgs for a while now, and I have no idea how to fix it.
• Even if I could fix it, Replit has stopped supporting free education accounts, and started trying to shove LLMs into everything, making it no longer a viable teaching platform.

Solution criteria

There are a few non-negotiable criteria that any solution must meet:

• It must either run on existing cloud infrastructure, or run completely client-side. I do not want to be in the business of running a server, or of worrying about mitigating DOS attacks (by which I mean students accidentally running infinite loops generating infinite amounts of memory). I also do not want to be in the business of managing accounts and logins.

• Students should not have to install anything. As I mentioned before, this is a nonstarter for some students.

• It should allow students to work at a Disco REPL, and also test their own Disco code.

Potential solutions

• Of course, a really nice solution would be to find an existing site which replicates some of the functionality we used to have with Replit and supports educational uses. I kind of doubt such a thing exists, though I would be happy to be wrong about this.

• Another possibility is to have students use VSCode in their browsers via GitHub; to make this work we would have to add LSP support to Disco and package it up appropriately. I’m not really excited about using GitHub for this, although implementing LSP for Disco is independently a great idea.

• The other solution I can think of is to compile Disco to WASM, and build a web UI on top of it, so that the whole thing runs in the student’s browser. I spent some time on this last year and successfully got Disco to compile to WASM, but didn’t make it any farther than that. Honestly, I simply don’t know anything about web development, and I am not very motivated to learn.

UI levels

Running with the last idea above (WASM + a custom web UI), what could such a thing look like? What features would we want? Here are some different solutions I could imagine, in increasing order of effort.

• Level 0 would be to have just a web-based REPL. Students can edit Disco code on their own device, upload it to the website, then evaluate expressions at the REPL. Having to reupload their code every time they make changes would be annoying, but this would still be better than nothing.

• Level 1 would be to have a web-based editor and REPL. Students can type code in the editor, then push a button to load it into the REPL and play with it.

• Level 2 would be to have a web-based filesystem + editor + REPL. Students can see a list of multiple files, edit them individually, and load any of them into the REPL. The filesystem must live on their own computer, not on a remote server; but it could be their real filesystem, or a virtual filesystem.

I don’t know how difficult any of these are; I would assume that at least some of them can be achieved by gluing together some existing Javascript components (e.g. CodeMirror?). I’m sure it will require extending Disco itself with some new APIs, but I can definitely work on that part once I know what would be needed.

If you know how to build web UIs like this and are interested in helping, get in touch!

Background

This section is repeated from my previous post, which I assume no one remembers.

First, some imports and a module declaration. Note that the entire development is parameterized by some abstract set B of base types, which must have decidable equality.

open import Data.Product using (Σ ; _×_ ; _,_ ; -,_ ; proj₁ ; proj₂)
open import Data.Product.Properties using (≡-dec)
open import Function using (_∘_)
open import Relation.Binary using (DecidableEquality)
open import Relation.Binary.PropositionalEquality using (_≡_ ; refl)
open import Relation.Nullary.Decidable using (yes; no; Dec)

module OneLevelTypesIndexed2 (B : Set) (≟B : DecidableEquality B) where

We’ll work with a simple type system containing base types, function types, and some distinguished type constructor □. So far, this is just to give some context; it is not the final version of the code we will end up with, so we stick it in a local module so it won’t end up in the top-level namespace.

module Unindexed where
  data Ty : Set where
    base : B → Ty
    _⇒_ : Ty → Ty → Ty
    □_ : Ty → Ty

For example, if \(X\) and \(Y\) are base types, then we could write down a type like \(\square ((\square \square X \to Y) \to \square Y)\):

  infixr 2 _⇒_
  infix 30 □_

  postulate
    BX BY : B

  X : Ty
  X = base BX
  Y : Ty
  Y = base BY

  example : Ty
  example = □ ((□ □ X ⇒ Y) ⇒ □ Y)

However, for reasons that would take us too far afield in this blog post, I don’t want to allow immediately nested boxes, like \(\square \square X\). We can still have multiple boxes in a type, and even boxes nested inside of other boxes, as long as there is at least one arrow in between. In other words, I only want to rule out boxes immediately applied to another type with an outermost box. So we don’t want to allow the example type given above (since it contains \(\square \square X\)), but, for example, \(\square ((\square X \to Y) \to \square Y)\) would be OK.

Two encodings

In my previous blog post, I ended up with the following encoding of types indexed by a Boxity, which records the number of top-level boxes. Since the boxity of the arguments to an arrow type do not matter, we make them sigma types that package up a boxity with a type having that boxity. I was then able to define decidable equality for ΣTy and Ty by mutual recursion.

data Boxity : Set where
  ₀ : Boxity
  ₁ : Boxity

variable b b₁ b₂ b₃ b₄ : Boxity

module WithSigma where
  ΣTy : Set
  data Ty : Boxity → Set

  ΣTy = Σ Boxity Ty

  data Ty where
    □_ : Ty ₀ → Ty ₁
    base : B → Ty ₀
    _⇒_ : ΣTy → ΣTy → Ty ₀

The problem is that working with this definition of Ty is really annoying! Every time we construct or pattern-match on an arrow type, we have to package up each argument type into a dependent pair with its Boxity; this introduces syntactic clutter, and in many cases we know exactly what the Boxity has to be, so it’s not even informative. The version we really want looks more like this:

data Ty : Boxity → Set where
  base : B → Ty ₀
  _⇒_ : {b₁ b₂ : Boxity} → Ty b₁ → Ty b₂ → Ty ₀
  □_ : Ty ₀ → Ty ₁

infixr 2 _⇒_
infix 30 □_

In this version, the boxities of the arguments to the arrow constructor are just implicit parameters of the arrow constructor itself. Previously, I was unable to get decidable equality to go through for this version… but just the other day, I finally realized how to make it work!

Path-dependent equality

The key trick that makes everything work is to define a path-dependent equality type. I learned this from Martín Escardó. The idea is that we can express equality between two indexed things with different indices, as long as we also have an equality between the indices.

_≡⟦_⟧_ : {A : Set} {B : A → Set} {a₀ a₁ : A} → B a₀ → a₀ ≡ a₁ → B a₁ → Set
b₀ ≡⟦ refl ⟧ b₁   =   b₀ ≡ b₁

That’s exactly what we need here: the ability to express equality between Ty values, which may be indexed by different boxities—as long as we know that the boxities are equal.

Decidable equality for Ty

We can now use this to directly encode decidable equality for Ty. First, we can easily define decidable equality for Boxity.

Boxity-≟ : DecidableEquality Boxity
Boxity-≟ ₀ ₀ = yes refl
Boxity-≟ ₀ ₁ = no λ ()
Boxity-≟ ₁ ₀ = no λ ()
Boxity-≟ ₁ ₁ = yes refl

Here is the type of the decision procedure: given two Ty values which may have different boxities, we decide whether or not we can produce a witness to their equality. Such a witness consists of a pair of (1) a proof that the boxities are equal, and (2) a proof that the types are equal, depending on (1).We would really like to write this as Σ (b₁ ≡ b₂) λ p → σ ≡⟦ p ⟧ τ, but for some reason Agda requires us to fill in some extra implicit arguments before it is happy that everything is unambiguous, requiring some ugly syntax.

Ty-≟′ : (σ : Ty b₁) → (τ : Ty b₂) → Dec (Σ (b₁ ≡ b₂) λ p → _≡⟦_⟧_ {_} {Ty} σ p τ)

Before showing the definition of Ty-≟′, let’s see that we can use it to easily define both a boxity-homogeneous version of decidable equality for Ty, as well as decidable equality for Σ Boxity Ty:

Ty-≟ : DecidableEquality (Ty b)
Ty-≟ {b} σ τ with Ty-≟′ σ τ
... | no σ≢τ = no (λ σ≡τ → σ≢τ ( refl , σ≡τ))
... | yes (refl , σ≡τ) = yes σ≡τ

ΣTy-≟ : DecidableEquality (Σ Boxity Ty)
ΣTy-≟ (_ , σ) (_ , τ) with Ty-≟′ σ τ
... | no σ≢τ = no λ { refl → σ≢τ (refl , refl) }
... | yes (refl , refl) = yes refl

A lot of pattern matching on refl and everything falls out quite easily.

And now the definition of Ty-≟′. It looks complicated, but it is actually not very difficult. The most interesting case is when comparing two arrow types for equality: we must first compare the boxities of the arguments, then consider the arguments themselves once we know the boxities are equal.

Ty-≟′ (□ σ) (□ τ) with Ty-≟′ σ τ
... | yes (refl , refl) = yes (refl , refl)
... | no σ≢τ = no λ { (refl , refl) → σ≢τ (refl , refl) }
Ty-≟′ (base S) (base T) with ≟B S T
... | yes refl = yes (refl , refl)
... | no S≢T = no λ { (refl , refl) → S≢T refl }
Ty-≟′ (_⇒_ {b₁} {b₂} σ₁ σ₂) (_⇒_ {b₃} {b₄} τ₁ τ₂) with Boxity-≟ b₁ b₃ | Boxity-≟ b₂ b₄ | Ty-≟′ σ₁ τ₁ | Ty-≟′ σ₂ τ₂
... | no b₁≢b₃ | _ | _ | _ = no λ { (refl , refl) → b₁≢b₃ refl }
... | yes _ | no b₂≢b₄ | _ | _ = no λ { (refl , refl) → b₂≢b₄ refl }
... | yes _ | yes _ | no σ₁≢τ₁ | _ = no λ { (refl , refl) → σ₁≢τ₁ (refl , refl) }
... | yes _ | yes _ | yes _ | no σ₂≢τ₂ = no λ { (refl , refl) → σ₂≢τ₂ (refl , refl) }
... | yes _ | yes _ | yes (refl , refl) | yes (refl , refl) = yes (refl , refl)
Ty-≟′ (□ _) (base _) = no λ ()
Ty-≟′ (□ _) (_ ⇒ _) = no λ ()
Ty-≟′ (base _) (□ _) = no λ ()
Ty-≟′ (base _) (_ ⇒ _) = no λ { (refl , ()) }
Ty-≟′ (_ ⇒ _) (□ _) = no λ ()
Ty-≟′ (_ ⇒ _) (base _) = no λ { (refl , ()) }

Motivation

In my previous post, we saw that if we have a static sequence and a binary operation with a group structure (i.e. every element has an inverse), we can precompute a prefix sum table in \(O(n)\) time, and then use it to answer arbitrary range queries in \(O(1)\) time.

What if we don’t have inverses? We can’t use prefix sums, but can we do something else that still allows us to answer range queries in \(O(1)\)? One thing we could always do would be to construct an \(n \times n\) table storing the answer to every possible range query—that is, \(Q[i,j]\) would store the value of the range \(a_i \diamond \dots \diamond a_j\). Then we could just look up the answer to any range query in \(O(1)\). Naively computing the value of each \(Q[i,j]\) would take \(O(n)\) time, for a total of \(O(n^3)\) time to fill in each of the entries in the tableWe only have to fill in \(Q[i,j]\) where \(i < j\), but this is still about \(n^2/2\) entries.

, though it’s not too hard to fill in the table in \(O(n^2)\) total time, spending only \(O(1)\) to fill in each entry—I’ll leave this to you as an exercise.

However, \(O(n^2)\) is often too big. Can we do better? More generally, we are looking for a particular subset of range queries to precompute, such that the total number is asymptotically less than \(n^2\), but we can still compute the value of any arbitrary range query by combining some (constant number of) precomputed ranges. In the case of a group structure, we were able to compute the values for only prefix ranges of the form \(1 \dots k\), then compute the value of an arbitrary range using two prefixes, via subtraction.

A sparse table is exactly such a scheme for precomputing a subset of ranges.In fact, I believe, but do not know for sure, that this is where the name “sparse table” comes from—it is “sparse” in the sense that it only stores a sparse subset of range values.

Rather than only a linear number of ranges, as with prefix sums, we have to compute \(O(n \lg n)\) of them, but that’s still way better than \(O(n^2)\). Note, however, that a sparse table only works when the combining operation is idempotent, that is, when \(x \diamond x = x\) for all \(x\). For example, we can use a sparse table with combining operations such as \(\max\) or \(\gcd\), but not with \(+\) or \(\times\). Let’s see how it works.

Sparse tables

The basic idea behind a sparse table is that we precompute a series of “levels”, where level \(i\) stores values for ranges of length \(2^i\). So level \(0\) stores “ranges of length \(1\)”—that is, the elements of the original sequence; level \(1\) stores ranges of length \(2\); level \(2\) stores ranges of length \(4\); and so on. Formally, \(T[i,j]\) stores the value of the range of length \(2^i\) starting at index \(j\). That is,

\[T[i,j] = a_j \diamond \dots \diamond a_{j+2^i-1}.\]

We can see that \(i\) only needs to go from \(0\) up to \(\lfloor \lg n \rfloor\); above that and the stored ranges would be larger than the entire sequence. So this table has size \(O(n \lg n)\).

Two important questions remain: how do we compute this table in the first place? And once we have it, how do we use it to answer arbitrary range queries in \(O(1)\)?

Computing the table is easy: each range on level \(i\), of length \(2^i\), is the combination of two length-\(2^{i-1}\) ranges from the previous level. That is,

\[T[i,j] = T[i-1, j] \diamond T[i-1, j+2^{i-1}]\]

The zeroth level just consists of the elements of the original sequence, and we can compute each subsequent level using values from the previous level, so we can fill in the entire table in \(O(n \lg n)\) time, doing just a single combining operation for each value in the table.

Once we have the table, we can compute the value of an arbitrary range \([l,r]\) as follows:

• Compute the biggest power of two that fits within the range, that is, the largest \(k\) such that \(2^k \leq r - l + 1\). We can compute this simply as \(\lfloor \lg (r - l + 1) \rfloor\).

• Look up two range values of length \(2^k\), one for the range which begins at \(l\) (that is, \(T[k, l]\)) and one for the range which ends at \(r\) (that is, \(T[k, r - 2^k + 1]\)). These two ranges overlap; but because the combining operation is idempotent, combining the values of the ranges yields the value for our desired range \([l,r]\).

  This is why we require the combining operation to be idempotent: otherwise the values in the overlap would be overrepresented in the final, combined value.

Haskell code

Let’s write some Haskell code! First, a little module for idempotent semigroups. Note that we couch everything in terms of semigroups, not monoids, because we have no particular need of an identity element; indeed, some of the most important examples like \(\min\) and \(\max\) don’t have an identity element. The IdempotentSemigroup class has no methods, since as compared to Semigroup it only adds a law. However, it’s still helpful to signal the requirement. You might like to convince yourself that all the instances listed below really are idempotent.

module IdempotentSemigroup where

import Data.Bits
import Data.Semigroup

-- | An idempotent semigroup is one where the binary operation
--   satisfies the law @x <> x = x@ for all @x@.
class Semigroup m => IdempotentSemigroup m

instance Ord a => IdempotentSemigroup (Min a)
instance Ord a => IdempotentSemigroup (Max a)
instance IdempotentSemigroup All
instance IdempotentSemigroup Any
instance IdempotentSemigroup Ordering
instance IdempotentSemigroup ()
instance IdempotentSemigroup (First a)
instance IdempotentSemigroup (Last a)
instance Bits a => IdempotentSemigroup (And a)
instance Bits a => IdempotentSemigroup (Ior a)
instance (IdempotentSemigroup a, IdempotentSemigroup b) => IdempotentSemigroup (a,b)
instance IdempotentSemigroup b => IdempotentSemigroup (a -> b)

Now, some code for sparse tables. First, a few imports.

{-# LANGUAGE TupleSections #-}

module SparseTable where

import Data.Array (Array, array, (!))
import Data.Bits (countLeadingZeros, finiteBitSize, (!<<.))
import IdempotentSemigroup

The sparse table data structure itself is just a 2D array over some idempotent semigroup m. Note that UArray would be more efficient, but (1) that would make the code for building the sparse table more annoying (more on this later), and (2) it would require a bunch of tedious additional constraints on m.

newtype SparseTable m = SparseTable (Array (Int, Int) m)
  deriving (Show)

We will frequently need to compute rounded-down base-two logarithms, so we define a function for it. A straightforward implementation would be to repeatedly shift right by one bit and count the number of shifts needed to reach zero; however, there is a better way, using Data.Bits.countLeadingZeros. It has a naive default implementation which counts right bit shifts, but in most cases it compiles down to much more efficient machine instructions.

-- | Logarithm base 2, rounded down to the nearest integer.  Computed
--   efficiently using primitive bitwise instructions, when available.
lg :: Int -> Int
lg n = finiteBitSize n - 1 - countLeadingZeros n

Now let’s write a function to construct a sparse table, given a sequence of values. Notice how the sparse table array st is defined recursively. This works because the Array type is lazy in the stored values, with the added benefit that only the array values we end up actually needing will be computed. However, this comes with a decent amount of overhead. If we wanted to use an unboxed array instead, we wouldn’t be able to use the recursive definition trick; instead, we would have to use an STUArray and fill in the values in a specific order. The code for this would be longer and much more tedious, but could be faster if we end up needing all the values in the array anyway.

-- | Construct a sparse table which can answer range queries over the
--   given list in $O(1)$ time.  Constructing the sparse table takes
--   $O(n \lg n)$ time and space, where $n$ is the length of the list.
fromList :: IdempotentSemigroup m => [m] -> SparseTable m
fromList ms = SparseTable st
 where
  n = length ms
  lgn = lg n

  st =
    array ((0, 0), (lgn, n - 1)) $
      zip ((0,) <$> [0 ..]) ms
        ++ [ ((i, j), st ! (i - 1, j) <> st ! (i - 1, j + 1 !<<. (i - 1)))
           | i <- [1 .. lgn]
           , j <- [0 .. n - 1 !<<. i]
           ]

Finally, we can write a function to answer range queries.

-- | \$O(1)$. @range st l r@ computes the range query which is the
--   @sconcat@ of all the elements from index @l@ to @r@ (inclusive).
range :: IdempotentSemigroup m => SparseTable m -> Int -> Int -> m
range (SparseTable st) l r = st ! (k, l) <> st ! (k, r - (1 !<<. k) + 1)
 where
  k = lg (r - l + 1)

Applications

Most commonly, we can use a sparse table to find the minimum or maximum values on a range, \(\min\) and \(\max\) being the quintessential idempotent operations. For example, this plays a key role in a solution to the (quite tricky) problem Ograda.At first it seemed like that problem should be solvable with some kind of sliding window approach, but I couldn’t figure out how to make it work!

What if we want to find the index of the minimum or maximum value in a given range (see, for example, Worst Weather)? We can easily accomplish this using the semigroup Min (Arg m i) (or Max (Arg m i)), where m is the type of the values and i is the index type. Arg, from Data.Semigroup, is just a pair which uses only the first value for its Eq and Ord instances, and carries along the second value (which is also exposed via Functor, Foldable, and Traversable instances). In the example below, we can see that the call to range st 0 3 returns both the max value on the range (4) and its index (2) which got carried along for the ride:

λ> :m +Data.Semigroup
λ> st = fromList (map Max (zipWith Arg [2, 3, 4, 2, 7, 4, 9] [0..]))
λ> range st 0 3
Max {getMax = Arg 4 2}

Finally, I will mention that being able to compute range minimum queries is one way to compute lowest common ancestors for a (static, rooted) tree. First, walk the tree via a depth-first search and record the depth of each node encountered in sequence, a so-called Euler tour (note that you must record every visit to a node—before visiting any of its children, in between each child, and after visiting all the children). Now the minimum depth recorded between visits to any two nodes will correspond to their lowest common ancestor.

Here are a few problems that involve computing least common ancestors in a tree, though note there are also other techniques for computing LCAs (such as binary jumping) which I plan to write about eventually.

• Tourists
• Stogovi
• Win Diesel

Precomputing prefix sums

Suppose we have a static sequence of values \(a_1, a_2, a_3, \dots, a_n\) drawn from some groupThat is, there is an associative binary operation with an identity element, and every element has an inverse.

, and want to be able to compute the total value (according to the group operation) of any contiguous subrange. That is, given a range \([i,j]\), we want to compute \(a_i \diamond a_{i+1} \diamond \dots \diamond a_j\) (where \(\diamond\) is the group operation). For example, we might have a sequence of integers and want to compute the sum, or perhaps the bitwise xor (but not the maximum) of all the values in any particular subrange.

Of course, we could simply compute \(a_i \diamond \dots \diamond a_j\) directly, but that takes \(O(n)\) time. With some simple preprocessing, it’s possible to compute the value of any range in constant time.

The key idea is to precompute an array \(P\) of prefix sums, so \(P_i = a_1 \diamond \dots \diamond a_i\). This can be computed in linear time via a scan; for example:

import Data.Array
import Data.List (scanl')

prefix :: Monoid a => [a] -> Array Int a
prefix a = listArray (0, length a) $ scanl' (<>) mempty a

⊕Actually, I would typically use an unboxed array, which is faster but slightly more limited in its uses: import Data.Array.Unboxed, use UArray instead of Array, and add an IArray UArray a constraint.

Note that we set \(P_0 = 0\) (or whatever the identity element is for the group); this is why I had the sequence of values indexed starting from \(1\), so \(P_0\) corresponds to the empty sum, \(P_1 = a_1\), \(P_2 = a_1 \diamond a_2\), and so on.

Now, for the value of the range \([i,j]\), just compute \(P_j \diamond P_{i-1}^{-1}\)—that is, we start with a prefix that ends at the right place, then cancel or “subtract” the prefix that ends right before the range we want. For example, to find the sum of the integers \(a_5 + \dots + a_{10}\), we can compute \(P_{10} - P_4\).

range :: Group a => Array Int a -> Int -> Int -> a
range p i j = p!j <> inv (p!(i-1))

That’s why this only works for groups but not for general monoids: only in a group can we cancel unwanted values. So, for example, this works for finding the sum of any range, but not the maximum.

Practice problems

Want to practice? Here are a few problems that can be solved using techniques discussed in this post:

• Determining Nucleotide Assortments
• Einvígi
• Srednji
• Veggja Kalli

It is possible to generalize this scheme to 2D—that is, to compute the value of any subrectangle of a 2D grid of values from some group in only \(O(1)\) time. I will leave you the fun of figuring out the details.

• Prozor
• Rust

If you’re looking for an extra challenge, here are a few harder problems which use techniques from this post as an important component, but require some additional nontrivial ingredients:

• Killing Chaos
• Ozljeda
• Vudu

Static range queries

Suppose we have a sequence of values, which is static in the sense that the values in the sequence will never change, and we want to perform range queries, that is, for various ranges we want to compute the total of all consecutive values in the range, according to some binary combining operation. For example, we might want to compute the maximum, sum, or product of all the consecutive values in a certain subrange. We have various options depending on the kind of ranges we want and the algebraic properties of the operation.

• If we want ranges corresponding to a sliding window, we can use an amortized queue structure to find the total of each range in \(O(1)\), for an arbitrary monoid.

• If we want arbitrary ranges but the operation is a group, the solution is relatively straightforward: we can precompute all prefix sums, and subtract to find the result for an arbitrary range in \(O(1)\).

• If the operation is an idempotent semigroup (that is, it has the property that \(x \diamond x = x\) for all \(x\)), we can use a sparse table, which takes \(O(n \lg n)\) time and space for precomputation, and then allows us to answer arbitrary range queries in \(O(1)\).

• If the operation is an arbitrary monoid, we can use a sqrt tree, which uses \(O(n \lg \lg n)\) precomputed time and space, and allows answering arbitrary range queries in \(O(\lg \lg n)\). I will write about this in a future post.

Dynamic range queries

What if we want dynamic range queries, that is, we want to be able to interleave range queries with arbitrary updates to the values of the sequence?

• If the operation is an arbitrary monoid, we can use a segment tree.
• If the operation is a group, we can use a Fenwick tree.

I published a paper about Fenwick trees, which also discusses segment trees, but I should write more about them here!

Table

Here’s a table summarizing the above classification scheme. I plan to fill in links as I write blog posts about each row.

Competitive Programming

First of all, what is competitive programming? It’s a broad term, but when I talk about competitive programming I have something in mind along the following lines:

• There are well-specified input and output formats, usually with a few examples, and a precise specification of what the output should be for a given input.
• Your job is to write a program which transforms input meeting the specification into a correct output.
• You submit your program, which is tested on a number of inputs and declared correct if and only if it yields the correct output for all the tested inputs.
• There is often time pressure involved—that is, you have a limited amount of time in which to write your program. However, it is also possible to participate “recreationally”, simply for the joy of problem-solving, without time pressure (in fact, the vast majority of the competitive programming I do is of this form, though I have occasionally participated in timed contests).

There are many variations: whether you are allowed to use code libraries prepared ahead of time, or must type everything from scratch; outputs can be scored according to some criteria rather than simply being judged right or wrong; and so on.

There are many sites which allow you to participate in contests and/or solve competitive programming problems recreationally. My favorite is Open Kattis; I mention some others at the end of this post.

Pot: a first example

As an introductory example, let’s look at Pot. As usual, there’s a silly story, but what it boils down to is that we will be given a sequence of numbers, and we should interpret the last digit of each number as an exponent, then sum the results. For example, if given 125, we should interpret it as \(12^5\), and so on.

interact :: (String -> String) -> IO ()

import Control.Category ((>>>))

main = interact $
  lines >>> drop 1 >>> map (read >>> process) >>> sum >>> show

process :: Integer -> Integer
process n = (n `div` 10) ^ (n `mod` 10)

Shopping List: wholemeal programming and ByteString

Let’s consider Shopping List as a second example. In this problem, we are given a list of shopping lists, where each shopping list consists of a list of space-separated items on a single line. We are asked to find the items which are common to all the shopping lists, and print them in alphabetical order.

{-# LANGUAGE ImportQualifiedPost #-}

import Control.Category ((>>>))
import Data.Set (Set)
import Data.Set qualified as S

main = interact $
  lines >>> drop 1 >>> map (words >>> S.fromList) >>>
  foldr1 S.intersection >>>
  (\s -> show (S.size s) : S.toList s) >>> unlines

{-# LANGUAGE ImportQualifiedPost #-}

import Control.Category ((>>>))
import Data.Set (Set)
import Data.Set qualified as S
import Data.ByteString.Lazy.Char8 qualified as BS

main = BS.interact $
  BS.lines >>> drop 1 >>> map (BS.words >>> S.fromList) >>>
  foldr1 S.intersection >>>
  (\s -> BS.pack (show (S.size s)) : S.toList s) >>> BS.unlines

A Favourable Ending: input parsing and lazy recursive structures

As a last example, let’s look at A Favourable Ending. This problem consists of a number of test cases; each test case describes a choose-your-own-adventure book with a number of sections, where each section is either an ending (either good or bad), or allows the reader to choose among three sections to proceed to next. For each test case, we are asked how many distinct stories there are with good endings.

More abstractly, since we are guaranteed that there are no loops, the sections of the book form a DAG, and we are asked to count the number of distinct paths in a DAG from a distinguished start node to any of a distinguished set of “good” leaves.

type Book = Map Int Section

data Section = End Disposition | Choice [Int]
  deriving (Eq, Show)

data Disposition = Favourably | Catastrophically
  deriving (Eq, Show, Read)

book :: Scanner Book
book = do
  s <- int
  M.fromList <$> s >< ((,) <$> int <*> section)

section :: Scanner Section
section = do
  t <- peek
  if isDigit (BS.head t)
    then Choice <$> (3 >< int)
    else End . readLower . BS.unpack <$> str

readLower :: Read a => String -> a
readLower = read . onHead toUpper

onHead :: (a -> a) -> [a] -> [a]
onHead _ [] = []
onHead f (x : xs) = f x : xs

main = BS.interact $ runScanner (numberOf book) >>> map (solve >>> showB) >>> BS.unlines

solve :: Book -> Int
solve book = endings ! 1
  where
    endings = M.fromList [(p, endingsFrom (book!p)) | p <- M.keys book]
    endingsFrom (End d) = if d == Favourably then 1 else 0
    endingsFrom (Choice ps) = sum $ map (endings !) ps

Resources

Here are some resources in case you’re interested in exploring more.

• Open Kattis has a collection of thousands of high-quality problems which can be solved in Haskell (or many other languages). If you just want to try solving some problems for fun, it’s a great place to start.
• There are also other sites which accept Haskell, such as Codeforces. Check these out if you want to actually participate in timed contests.
• My public listing of Kattis problems I have solved, with my own personal rating system.
• I’ve written a series of blog posts about competitive programming in Haskell, on a variety of topics.
• I also have a repository of modules I’ve developed specifically for competitive programming. Many of the modules are documented in one or more blog posts.
• Soumik Sarkar has an even larger collection of Haskell libraries for competitive programming.