How to define division operator in Agda? - functional-programming

I want to divide two natural number. I have made function like this
_/_ : N -> N -> frac
m / one = m / one
(suc m) / n = ?? I dont know what to write here.
Please help.

As #gallais says you can use well-founded recursion explicitly, but I don't like this approach, because it's totally unreadable.
This datatype
record Is {α} {A : Set α} (x : A) : Set α where
¡ = x
open Is
! : ∀ {α} {A : Set α} -> (x : A) -> Is x
! _ = _
allows to lift values to the type level, for example you can define a type-safe pred function:
pred⁺ : ∀ {n} -> Is (suc n) -> ℕ
pred⁺ = pred ∘ ¡
Then
test-1 : pred⁺ (! 1) ≡ 0
test-1 = refl
typechecks, while
fail : pred⁺ (! 0) ≡ 0
fail = refl
doesn't. It's possible to define subtraction with positive subtrahend (to ensure well-foundness) in the same way:
_-⁺_ : ∀ {m} -> ℕ -> Is (suc m) -> ℕ
n -⁺ im = n ∸ ¡ im
Then using stuff that I described here, you can repeatedly subtract one number from another until the difference is smaller than the second number:
lem : ∀ {n m} {im : Is (suc m)} -> m < n -> n -⁺ im <′ n
lem {suc n} {m} (s≤s _) = s≤′s (≤⇒≤′ (n∸m≤n m n))
iter-sub : ∀ {m} -> ℕ -> Is (suc m) -> List ℕ
iter-sub n im = calls (λ n -> n -⁺ im) <-well-founded lem (_≤?_ (¡ im)) n
For example
test-1 : iter-sub 10 (! 3) ≡ 10 ∷ 7 ∷ 4 ∷ []
test-1 = refl
test-2 : iter-sub 16 (! 4) ≡ 16 ∷ 12 ∷ 8 ∷ 4 ∷ []
test-2 = refl
div⁺ then is simply
_div⁺_ : ∀ {m} -> ℕ -> Is (suc m) -> ℕ
n div⁺ im = length (iter-sub n im)
And a version similar to the one in the Data.Nat.DivMod module (only without the Mod part):
_div_ : ℕ -> (m : ℕ) {_ : False (m ≟ 0)} -> ℕ
n div 0 = λ{()}
n div (suc m) = n div⁺ (! (suc m))
Some tests:
test-3 : map (λ n -> n div 3)
(0 ∷ 1 ∷ 2 ∷ 3 ∷ 4 ∷ 5 ∷ 6 ∷ 7 ∷ 8 ∷ 9 ∷ [])
≡ (0 ∷ 0 ∷ 0 ∷ 1 ∷ 1 ∷ 1 ∷ 2 ∷ 2 ∷ 2 ∷ 3 ∷ [])
test-3 = refl
Note however, that the version in the standard library also contains the soundness proof:
property : dividend ≡ toℕ remainder + quotient * divisor
The whole code.

Division is usually defined as iterated substraction which requires a slightly unusual induction principle. See e.g. the definition in the standard library.

Related

Increment binary value type by one

I want to increment a binary value by one, but I'm still not very familiar with how recursion in agda works.
Why aren't I getting the right output here?
Bin Type Definition
data Bin : Set where
⟨⟩ : Bin
_O : Bin → Bin
_I : Bin → Bin
My increment function
inc : Bin → Bin
inc ⟨⟩ = ⟨⟩ I
inc (x O) = ⟨⟩ I
inc (x I) = (inc x) I
A quick correction of your algorithm
Your increment function is not correct. Considering your definition of binary numbers:
data Bin : Set where
⟨⟩ : Bin
_O : Bin → Bin
_I : Bin → Bin
Your increment function should be written as follows:
inc : Bin → Bin
inc ⟨⟩ = ⟨⟩ I
inc (x O) = x I
inc (x I) = (inc x) O
When the right number is zero, you just replace it by one, but you must not forget to keep the left part of the number.
When the right number is 1, you have to keep incrementing its left part, but you also need to transform this 1 into a 0.
A quick validation of the new algorithm
But, don't take my word for it, let us try and (partially) validate our function. After all, we are in a proof assistant, aren't we ?
A good way to validate such a function is to assess which property it should provide. The result of your incremental function has to be equal to 1 plus its input value. Agda provides natural numbers so let us transform your binary numbers into naturals to check such a property. First, some imports:
open import Data.Nat
open import Data.Nat.Properties
open import Relation.Binary.PropositionalEquality
Then a function which transforms a binary number into a natural number:
_↑ : Bin → ℕ
⟨⟩ ↑ = 0
(x O) ↑ = x ↑ + x ↑
(x I) ↑ = suc (x ↑ + x ↑)
Finally, our validation property:
prop : ∀ {b} → (inc b) ↑ ≡ suc (b ↑)
prop {⟨⟩} = refl
prop {b O} = refl
prop {b I} rewrite prop {b} | +-suc (b ↑) (b ↑) = refl
This validation is of course incomplete (by nature) but at least it gives you confidence in your algorithm. You should always try and prove such assumptions when writing algorithms, which is the whole point of Agda (well, not the whole point, but at least part of it).
More on validation
To further make my point, I decided to try and keep validating your representation of binary numbers by implementing the reciprocal transformation from naturals to binary numbers:
_↓ : ℕ → Bin
zero ↓ = ⟨⟩
suc n ↓ = inc (n ↓)
We can directly prove that the two transformations are reciprocal when going up then down:
↑↓ : ∀ {n} → (n ↓) ↑ ≡ n
↑↓ {zero} = refl
↑↓ {suc n} rewrite prop {n ↓} | ↑↓ {n} = refl
Then I tried to do the other way around:
↓↑ : ∀ {b} → (b ↑) ↓ ≡ b
↓↑ {⟨⟩} = refl
↓↑ {b O} rewrite prop₂ {b ↑} rewrite ↓↑ {b} = refl
↓↑ {b I} rewrite prop₂ {b ↑} rewrite ↓↑ {b} = refl
This side needs prop₂ which has the following signature:
prop₂ : ∀ {n} → (n + n) ↓ ≡ (n ↓) O
This property should be true (in the sense that the binary numbers as we think of them should satisfy it), but it cannot be proven in your formalism because you can represent zero in an infinite number of ways, and all these ways are not prepositionally equal (for instance, the first case of prop₂ when n is equal to 0 requires to prove ⟨⟩ ≡ (⟨⟩ O) which cannot be proven).
All in all, validation not only allows us to find faulty algorithms (or to prove algorithms correct) but it can also reveal inconsistencies or mistakes in the basics of our theories themselves (even though in this case, a quick look could have been enough to see that 0 can be represented an infinite number of different manners).
As a side note, I am not saying that there should always be a single way of representing a specific element of an abstract data type, but it surely helps, especially when working with propositional equality, which is very often required.
On another side note, I am sorry if I got a little carried away but I find these kind of topics very enlightening regarding the use of proof assistants and formal validation.
Please feel free to ask for any further explanation.
The complete (and incomplete in a way) code
module BinaryNumber where
open import Data.Nat
open import Data.Nat.Properties
open import Relation.Binary.PropositionalEquality
data Bin : Set where
⟨⟩ : Bin
_O : Bin → Bin
_I : Bin → Bin
inc : Bin → Bin
inc ⟨⟩ = ⟨⟩ I
inc (x O) = x I
inc (x I) = (inc x) O
_↑ : Bin → ℕ
⟨⟩ ↑ = 0
(x O) ↑ = x ↑ + x ↑
(x I) ↑ = suc (x ↑ + x ↑)
prop : ∀ {b} → (inc b) ↑ ≡ suc (b ↑)
prop {⟨⟩} = refl
prop {b O} = refl
prop {b I} rewrite prop {b} | +-suc (b ↑) (b ↑) = refl
_↓ : ℕ → Bin
zero ↓ = ⟨⟩
suc n ↓ = inc (n ↓)
↑↓ : ∀ {n} → (n ↓) ↑ ≡ n
↑↓ {zero} = refl
↑↓ {suc n} rewrite prop {n ↓} | ↑↓ {n} = refl
prop₂ : ∀ {n} → (n + n) ↓ ≡ (n ↓) O
prop₂ {zero} = {!!}
prop₂ {suc n} = {!!}
↓↑ : ∀ {b} → (b ↑) ↓ ≡ b
↓↑ {⟨⟩} = refl
↓↑ {b O} rewrite prop₂ {b ↑} rewrite ↓↑ {b} = refl
↓↑ {b I} rewrite prop₂ {b ↑} rewrite ↓↑ {b} = refl
The standard library
As a last remark, the binary numbers are present in the standard library in the file Data.Nat.Binary.Base with the associated properties (in particular the properties of reciprocity which are not provable in your representation) in the file Data.Nat.Binary.Properties if you feel like looking how they are implemented there.
When we define inc as Bin → Bin, we are saying that it takes values of type Bin and returns values of the same type i.e. Bin.
Since we have 3 constructors available for creating Bin, all the values of type Bin would have one of the following 3 forms:
⟨⟩
b I where b is some value of type Bin
b O where b is some value of type Bin
For case 1, since ⟨⟩ stands for zero.
inc ⟨⟩ = ⟨⟩ I
For case 2, we know that adding one to a number ending with zero will just change the last digit to one, so
inc (x O) = x I
and for case 3, when a number is ending with 1, on incrementing it we get zero at the end, and carryover is generated that needs to be passed forward. Carryover can be passed by using our same inc function. Assuming (inc x) gives a binary number, we take that output and append zero at the end.
inc (x I) = (inc x) O
Also, just to extent upon the excellent answer given by MrO, who correctly pointed out that since there are infinitely many ways to represent zeros (and all numbers)
(b ↓) ↑ = b
can't be proved for b with leading zeros before the first significant digit. But if we restrict domain of ↓↑ to only binary numbers which are only canonical i.e binary number without any leading zeros, proof can be derived.
Proof of (b ↓) ↑ = b for canonical b
Extending MrO's code,
module BinaryNumber where
open import Data.Nat
open import Data.Nat.Properties
open import Relation.Binary.PropositionalEquality
open Relation.Binary.PropositionalEquality.≡-Reasoning
data Bin : Set where
⟨⟩ : Bin
_O : Bin → Bin
_I : Bin → Bin
inc : Bin → Bin
inc ⟨⟩ = ⟨⟩ I
inc (x O) = x I
inc (x I) = (inc x) O
_↑ : Bin → ℕ
⟨⟩ ↑ = 0
(x O) ↑ = x ↑ + x ↑
(x I) ↑ = suc (x ↑ + x ↑)
prop : ∀ {b} → (inc b) ↑ ≡ suc (b ↑)
prop {⟨⟩} = refl
prop {b O} = refl
prop {b I} rewrite prop {b} | +-suc (b ↑) (b ↑) = refl
_↓ : ℕ → Bin
zero ↓ = ⟨⟩ O
suc n ↓ = inc (n ↓)
↑↓ : ∀ {n} → (n ↓) ↑ ≡ n
↑↓ {zero} = refl
↑↓ {suc n} rewrite prop {n ↓} | ↑↓ {n} = refl
-- One b -> b start with ⟨⟩ I
data One : Bin → Set where
first : One (⟨⟩ I)
nextO : ∀ { b : Bin }
→ One b
------------
→ One (b O)
nextI : ∀ { b : Bin }
→ One b
------------
→ One (b I)
-- Can i.e Canonical representing binary numbers without extras leading zeros after ⟨⟩. For e.g ⟨⟩ O O I I and ⟨⟩ I I both represents binary form of number 3 but only ⟨⟩ I I is the canonical
data Can : Bin → Set where
startWithZero : Can (⟨⟩ O)
startWithOne : ∀ {b : Bin }
→ One b
------------
→ Can b
-- If m ≤ n then m ≤ (n + 1)
≤-sucʳ : ∀ {m n : ℕ }
→ m ≤ n
-----------
→ m ≤ suc n
≤-sucʳ z≤n = z≤n
≤-sucʳ (s≤s m≤n) = s≤s (≤-sucʳ m≤n)
-- If m ≤ n then m ≤ (n + p)
≤-addʳ : ∀ (m n p : ℕ)
→ m ≤ n
--------
→ m ≤ n + p
≤-addʳ m n zero m≤n rewrite +-comm n zero = m≤n
≤-addʳ m n (suc p) m≤n rewrite +-comm n (suc p) | +-comm p n = ≤-sucʳ (≤-addʳ m n p m≤n)
-- If a natural number n has eqivalent binary form (⟨⟩ I b) then 1 ≤ n
1-≤-oneb : ∀ { b : Bin }
→ One b
---------
→ suc zero ≤ b ↑
1-≤-oneb first = s≤s z≤n
1-≤-oneb {b O} (nextO oneb) = ≤-addʳ 1 ((b ↑)) ((b ↑)) (1-≤-oneb oneb)
1-≤-oneb {b I} (nextI oneb) = ≤-sucʳ (≤-addʳ 1 ((b ↑)) ((b ↑)) (1-≤-oneb oneb))
-- If 0 ≤ (n + 1) then 1 ≤ n
0-≤-suc : ∀ (n : ℕ)
→ 0 ≤ suc n
-----------
→ 1 ≤ suc n
0-≤-suc n z≤n = s≤s z≤n
-- If 1 ≤ n and binary form of n is b then binary form of (n + n) using ↓ is b O
↓-over-+ : ∀ (n : ℕ)
→ 1 ≤ n
-----------------------
→ (n + n) ↓ ≡ (n ↓) O
↓-over-+ (suc zero) s≤n = refl
↓-over-+ (suc (suc n)) (s≤s s≤n) = begin
(suc (suc n) + (suc (suc n))) ↓
≡⟨⟩
inc (( suc n + (suc (suc n))) ↓)
≡⟨ cong (inc) (cong (_↓) (+-comm (suc n) (suc (suc n)))) ⟩
inc (inc ((suc n + suc n) ↓))
≡⟨ cong (inc) (cong inc (↓-over-+ (suc n) (0-≤-suc n s≤n))) ⟩
refl
-- For all binary numbers that are canonical, ↑↓ is identity (returns same b)
↑↓-canb : ∀ ( b : Bin )
→ Can b
--------------
→ (b ↑) ↓ ≡ b
↑↓-canb _ startWithZero = refl
↑↓-canb _ (startWithOne first) = refl
↑↓-canb (b O) (startWithOne (nextO x)) rewrite ↓-over-+ (b ↑) (1-≤-oneb x) | ↑↓-canb b (startWithOne x) = refl
↑↓-canb (b I) (startWithOne (nextI x)) rewrite ↓-over-+ (b ↑) (1-≤-oneb x) | ↑↓-canb b (startWithOne x) = refl

Understanding failures of recursive calls on simple proof about FSA and regular languages in Agda

I'm trying to prove that a simple FSA in Agda only accepts string which end in zero- this is the first example in Sipser's book. I didn't implement evalFSA as a predicate, but rather as function, and am confused as to whether this was the right or wrong choice, as I'm now having trouble proving the soundness and completeness results with respect to the machine and the language, and whether this implementation detail is the cause of my difficululties.
As soon as I pattern match on x below, it highlights the below line blue. what does this mean, why is it doing it, and why does pattern matching on x0 resolve it?
soundM : (xs : List Σ') → evalFSA' M xs → endsIn0 xs
soundM (x ∷ []) evM = {!!}
soundM (x0 ∷ x1 ∷ xs) evM = {!!}
-- soundM (0' ∷ []) f = tt
and here is the final issue. why can't I apply the recursive call in the 1' case? the only difference between the f's is the use current state of the machine and the input string, but obviously this seems like a symmetry of the system that shouldn't effect our ability to compute.
soundM' : (xs : List Σ') → evalFSA' M xs → endsIn0 xs
soundM' (0' ∷ []) evM = tt
soundM' (0' ∷ x1 ∷ xs) f = soundM' (x1 ∷ xs) f
soundM' (1' ∷ x1 ∷ xs) f = soundM' {!!} f
Here is the inferred f in the 0' case:
f : modal.helper M 0' (x1 ∷ xs) M xs (δ' S₁ x1)
And similairly in the 1' case:
f : modal.helper M 1' (x1 ∷ xs) M xs (δ' S₂ x1)
I'm having, simultaneous issues with what I'm calling completeness as well
completeM : (xs : List Σ') → endsIn0 xs → evalFSA' M xs ≡ ⊤
completeM (0' ∷ []) ex = refl
completeM (0' ∷ x1 ∷ xs) ex = completeM (x1 ∷ xs) ex
completeM (1' ∷ x1 ∷ xs) ex = {!!}
Here is the code to get here
module fsa where
open import Bool
open import Level using (_⊔_)
open import Data.Nat.Base as Nat using (ℕ; zero; suc; _<′_; _+_)
open import Data.List.Base as List using (List; []; _∷_)
-- open import Data.Product as Prod using (∃; _×_; _,_)
open import Data.Empty
open import Data.Unit
open import Relation.Binary.PropositionalEquality using (_≡_; refl; subst)
-- open import Data.Fin as Fin
record FSA : Set₁ where
field
Q : Set
Σ : Set
δ : Q → Σ → Q
q₀ : Q
F : Q → Set
evalFSA' : (fsa : FSA) → List (FSA.Σ fsa) → Set
evalFSA' fsa [] = ⊥
evalFSA' fsa (x ∷ xs) = helper fsa (x ∷ xs) (FSA.q₀ fsa)
where
helper : (fsa : FSA) → List (FSA.Σ fsa) → (FSA.Q fsa) → Set
helper fsa [] q = FSA.F fsa q
helper fsa (x ∷ xs) q = helper fsa xs ((FSA.δ fsa) q x)
data Q' : Set where
S₁ : Q'
S₂ : Q'
data Σ' : Set where
0' : Σ'
1' : Σ'
q₀' : Q'
q₀' = S₁
F' : Q' → Set
F' S₁ = ⊤
F' S₂ = ⊥
δ' : Q' → Σ' → Q'
δ' S₁ 0' = S₁
δ' S₁ 1' = S₂
δ' S₂ 0' = S₁
δ' S₂ 1' = S₂
M : FSA
FSA.Q M = Q'
FSA.Σ M = Σ'
FSA.δ M = δ'
FSA.q₀ M = q₀'
FSA.F M = F'
exF1 = evalFSA' M (0' ∷ [])
exF2 = evalFSA' M (1' ∷ (0' ∷ 0' ∷ 1' ∷ []))
-- a more general endIn that i was orignally trying to use, but likewise failed to get to work
data Dec (A : Set) : Set where
yes : A → Dec A
no : (A → ⊥) → Dec A
sigDec : (x y : Σ') → Dec (x ≡ y)
sigDec 0' 0' = yes refl
sigDec 0' 1' = no (λ ())
sigDec 1' 0' = no (λ ())
sigDec 1' 1' = yes refl
endsIn : {X : Set} → ((x y : X) → Dec (x ≡ y)) → List X → X → Set
endsIn d [] x = ⊥
endsIn d (x ∷ []) x0 with (d x0 x)
... | yes refl = ⊤
... | no x1 = ⊥
endsIn d (x ∷ x1 ∷ xs) x0 = endsIn d (x1 ∷ xs) x0
_endsIn'_ : List Σ' → Σ' → Set
xs endsIn' x = endsIn sigDec xs x
endsIn0 : List Σ' → Set
endsIn0 [] = ⊥
endsIn0 (0' ∷ []) = ⊤
endsIn0 (0' ∷ x ∷ xs) = endsIn0 (x ∷ xs)
endsIn0 (1' ∷ xs) = endsIn0 xs
-- testing
10endsin0 = (1' ∷ 0' ∷ []) endsIn' 0'
n10endsin0 = (1' ∷ 1' ∷ []) endsIn' 0'
Your post is very large and contains numerous elements, which all can be commented in different ways. I will address them one by one, and explain the choices I made to make these elements more easily accessible. Note that these choices consist in minor elements in your codes, mostly cosmetic, which do not change in any way the semantics of your definitions. I start by giving you the correct code in details, after which I answer the questions.
The correct code in details
Let us start by cleaning up these imports to the minimum needed:
module FSA where
open import Data.List.Base
open import Data.Empty
open import Data.Unit
I then kept your definition of your automaton record:
record FSA : Set₁ where
field
Q : Set
Σ : Set
δ : Q → Σ → Q
q₀ : Q
F : Q → Set
I have extracted your helper function from the evalFSA' function. The reason for this change is that when using when, the function inherits all the parameters from the parent function, which makes it harder to comprehend further goals such as modal.helper M 0' (x1 ∷ xs) M xs (δ' S₁ x1).
helper : (fsa : FSA) → List (FSA.Σ fsa) → (FSA.Q fsa) → Set
helper fsa [] q = FSA.F fsa q
helper fsa (x ∷ xs) q = helper fsa xs ((FSA.δ fsa) q x)
evalFSA' : (fsa : FSA) → List (FSA.Σ fsa) → Set
evalFSA' fsa [] = ⊥
evalFSA' fsa (x ∷ xs) = helper fsa (x ∷ xs) (FSA.q₀ fsa)
Then your case study automaton remains the same, although I simplified the record instantiation without using copatterns:
data Q' : Set where
S₁ : Q'
S₂ : Q'
data Σ' : Set where
0' : Σ'
1' : Σ'
q₀' : Q'
q₀' = S₁
F' : Q' → Set
F' S₁ = ⊤
F' S₂ = ⊥
δ' : Q' → Σ' → Q'
δ' S₁ 0' = S₁
δ' S₁ 1' = S₂
δ' S₂ 0' = S₁
δ' S₂ 1' = S₂
M : FSA
M = record { Q = Q' ; Σ = Σ' ; δ = δ' ; q₀ = q₀' ; F = F' }
I also simplified your predicate endsWith0 as follows:
endsWith0 : List Σ' → Set
endsWith0 [] = ⊥
endsWith0 (0' ∷ []) = ⊤
endsWith0 (_ ∷ xs) = endsWith0 xs
From this point on, soundM and completeM are proved as follows (I homogenized their signatures):
soundM : ∀ xs → evalFSA' M xs → endsWith0 xs
soundM (0' ∷ []) evM = evM
soundM (0' ∷ x₁ ∷ xs) evM = soundM (x₁ ∷ xs) evM
soundM (1' ∷ 0' ∷ xs) evM = soundM (0' ∷ xs) evM
soundM (1' ∷ 1' ∷ xs) evM = soundM (1' ∷ xs) evM
completeM : ∀ xs → endsWith0 xs → evalFSA' M xs
completeM (0' ∷ []) ex = ex
completeM (0' ∷ x₁ ∷ xs) = completeM (x₁ ∷ xs)
completeM (1' ∷ 0' ∷ xs) = completeM (0' ∷ xs)
completeM (1' ∷ 1' ∷ xs) = completeM (1' ∷ xs)
Answers to non-proof related questions
On predicates vs functions returning types, you asked:
I didn't implement evalFSA as a predicate, but rather as function,
and am confused as to whether this was the right or wrong choice
There are no good answer to this question. Both ideas are possible, and often debated on other questions on this site. I personally always use predicates when possible, but others have arguments in favor of functions returning ⊤ or ⊥. And, as you noticed it is possible to prove what you wanted using your implementation.
On the weird highlighting, you asked:
it highlights the below line blue. what does this mean
As far as I know, this is a bug. Some weird coloration like that started to occasionally happen to me recently as well, but they apparently do not mean anything.
Answer to your proof-related question
You asked the following question:
why can't I apply the recursive call in the 1' case? the only
difference between the f's is the use current state of the machine and
the input string, but obviously this seems like a symmetry of the
system that shouldn't effect our ability to compute
Answering this question is actually quite simple, but this answer was somewhat hidden in your implementation because you embedded the definition of helper inside the definition of evalFSA', which I changed as explained.
Let us consider the following code while proving soundM:
soundM : (xs : List Σ') → evalFSA' M xs → endsWith0 xs
soundM (0' ∷ []) evM = evM
soundM (0' ∷ x ∷ xs) evM = soundM (x ∷ xs) {!evM!}
soundM (1' ∷ x ∷ xs) evM = soundM (x ∷ xs) {!evM!}
When asking Agda what is the goal and the type of the current element in the first goal, it answers:
Goal: helper M xs (δ' q₀' x)
Have: helper M xs (δ' S₁ x)
Since you have defined q₀' as follows:
q₀' : Q'
q₀' = S₁
Agda know that q₀' is definitionally equal to S₁ which means the current term has actually the same type as the goal, which is why it is accepted.
In the other hole however, asking Agda the same information gives:
Goal: helper M xs (δ' q₀' x)
Have: helper M xs (δ' S₂ x)
In this case, q₀' is not definitionally equal to S₂ (and not equal in any way actually) which means these types are not equal, and it is not possible to conclude right away.
As shown in my code, pattern matching an additional time on x allows agda to further reduce the goal which allows us to conclude.
A similar reasoning is used to provide a proof of completeM

Agda: Product of even numbers is even

I am pretty new to Agda. I am working on a question from the assignment. I have got most of it but there is one goal on which i am stuck.
data Arith : Set where
Num : ℕ → Arith
Plus : Arith → Arith → Arith
Times : Arith → Arith → Arith
eval : Arith → ℕ
eval (Num x) = x
eval (Plus e1 e2) = eval e1 + eval e2
eval (Times e1 e2) = eval e1 * eval e2
data Even : ℕ → Set where
zEven : Even 0
ssEven : {n : ℕ} → Even n → Even (suc (suc n))
-- [PROBLEM 1]
plusEven : ∀ n m → Even n → Even m → Even (n + m)
plusEven zero m x x₁ = x₁
plusEven (suc zero) m () x₁
plusEven (suc (suc .0)) m (ssEven zEven) x₁ = ssEven x₁
plusEven (suc (suc ._)) m (ssEven (ssEven x)) x₁ = ssEven (ssEven (plusEven _ m x x₁ ))
-- [PROBLEM 2]
timesEven : ∀ n m → Even n → Even m → Even (n * m)
timesEven zero m x x₁ = zEven
timesEven (suc ._) zero (ssEven x) x₁ = (timesEven _ zero x x₁)
timesEven (suc ._) (suc ._) (ssEven x) (ssEven x₁) = ssEven ((λ h → {!!}) (timesEven _ _ x x₁))
The goal I have to prove is
Goal: Even (.n₁ + suc (suc (.n₁ + .n * suc (suc .n₁))))
I feel that I have to use plusEven some how. But the goal does not look that straightforward. Have I made the problem difficult for me? or am I on the right track? Is there an easier way to do this? I don't want the solution to this. But a push in the right direction would be appreciated. I have been stuck on this for a while now.
If n is even, then n * m is even too, so it's irrelevant whether m is even or not and hence you should just throw away this constraint. So the actual theorems are (I made n and m implicit, because this is convenient)
timesEvenLeft : ∀ {n m} → Even n → Even (n * m)
timesEvenRight : ∀ {n m} → Even m → Even (n * m)
You can prove that n * m ≡ m * n and derive the latter theorem from the former. Hence it only remains to prove the first one. In the recursive case you need to prove Even (suc (suc n) * m) (which reduces to Even (m + (m + n * m)) having Even (n * m) (the induction hypothesis) in scope. For this you'll need yet another lemma:
plusDoubleEven : ∀ {n} m → Even n → Even (m + (m + n))
I really liked the answers posted here and they helped me a lot. But I cannot change the question given in the assignment. I used the answers posted to come up with a solution to the problem. It took me a while and it looks a little messy but it works. Thought i'd post it here too.
timesEven : ∀ n m → Even n → Even m → Even (n * m)
timesEven zero m x x₁ = zEven
timesEven (suc zero) m () x₁
timesEven (suc (suc n)) zero (ssEven x) x₁ = timesEven n zero x x₁
timesEven (suc (suc n)) (suc zero) x ()
timesEven (suc (suc n)) (suc (suc m)) (ssEven x) (ssEven x₁) = ssEven ((λ h → plusEven m (suc (suc (m + n * suc (suc m)))) x₁ (ssEven (plusEven m (n * suc (suc m)) x₁ h))) (timesEven n (suc (suc m)) x (ssEven x₁)))
It's probably not what is expected of you for this homework but a clean way to deal with these lemmas without doing too much work is, as hinted at by #user3237465, to reuse well-known properties of the natural numbers.
One way to get more out of these well-known properties is to introduce an alternative definition of Even which you can prove equivalent to the inductive one:
data Even : ℕ → Set where
zEven : Even 0
ssEven : {n : ℕ} → Even n → Even (suc (suc n))
record Even′ (n : ℕ) : Set where
constructor mkEven′
field factor : ℕ
.equality : n ≡ factor * 2
open Even′
Even⇒Even′ : {n : ℕ} → Even n → Even′ n
(...)
Even′⇒Even : {n : ℕ} → Even′ n → Even n
(...)
You can then prove plusEven and timesEven(Right/Left) by using equational reasoning, reusing lemmas from the standard library. For instance the proof of plusEven becomes:
plusEven′ : ∀ n m → Even′ n → Even′ m → Even′ (n + m)
plusEven′ n m (mkEven′ p Hp) (mkEven′ q Hq) = mkEven′ (p + q) eq where
.eq : n + m ≡ (p + q) * 2
eq = begin
n + m ≡⟨ cong₂ _+_ Hp Hq ⟩
p * 2 + q * 2 ≡⟨ sym (distribʳ-*-+ 2 p q) ⟩
(p + q) * 2
∎
plusEven : ∀ n m → Even n → Even m → Even (n + m)
plusEven n m en em = Even′⇒Even (plusEven′ n m (Even⇒Even′ en) (Even⇒Even′ em))
Here is a gist with all the right imports and all the proofs.

Agda Programming- Proving Insertionsort makes 3 or less comparisons on a list of size 3

Good Evening Fellows,
I am attempting to prove that insertionsort will perform <= 3 comparisons in a list of size 3 while sorting. Last part of my project and cannot make any headway on it. After spending fair amount of time pursuing an incorrect approach, my instructor informed me it may be accomplished by writing a helper function to assist. I unfortunately have not come up with any piece of code to help. If anyone can offer advice or assistance, any and all are appreciated. Code follows. Thanks!
insert : ℕ → 𝕃 ℕ → 𝕃 ℕ × ℕ
insert x (h :: t) = if h < x then (x :: h :: t , 1) else let r = insert
x t in h :: (fst r) , 1 + snd r
insert x [] = x :: [] , 0
insertionsort : 𝕃 ℕ → 𝕃 ℕ × ℕ
insertionsort [] = [] , 0
insertionsort (h :: t) with insertionsort t
insertionsort (h :: t) | t' , c1 with insert h t'
insertionsort (h :: t) | t' , c1 | r , c2 = r , c1 + c2
exampleThm : ∀(x y z c : ℕ)(r : 𝕃 ℕ) → insertionsort (x :: y :: z :: [])
≡ r , c → c ≤ 3 ≡ tt
exampleThm x y z = ?`
All the comparisons to be done in the course of insertionsort are actually done in the course of subordinate calls to insert. It may help to establish a useful fact about the comparison cost of insert. If you can bound the cost of each call to insert, you should be able to combine those bounded partial costs together to make a bounded total cost. In case your instructor is concerned that I am helping too much, let me summarize by saying that all I am saying is that the structure of the proof has to follow the structure of the program.
A general pattern when constructing proofs is to generalize them to make them easier. In this case I believe it is more clear to solve the generalized bound for the number of comparisons that insertion sort will do and then instantiate that to your particular input.
The structure of your proof will follow the structure of your program.
First we'll need to characterize the behavior of insert, since insertion sort is implemented in terms of it.
insert-bound : ∀ x ys → proj₂ (insert x ys) ≤ length ys
Then we'll use that to characterize the behavior of insertion sort
bound : ℕ → ℕ
bound 0 = 0
bound (suc n) = bound n + n
insertionsort-bound : ∀ xs → proj₂ (insertionsort xs) ≤ bound (length xs)
Using the general solution we can solve the specific case of a three element list
exampleThm : ∀ x y z c r → insertionsort (x ∷ y ∷ z ∷ []) ≡ (r , c) → c ≤ 3
exampleThm x y z ._ ._ refl = insertionsort-bound (x ∷ y ∷ z ∷ [])
Here's an implementation against the Agda standard library of your problem:
http://www.galois.com/~emertens/insertionsort-agda/Insertionsort.html

Assisting Agda's termination checker

Suppose we define a function
f : N \to N
f 0 = 0
f (s n) = f (n/2) -- this / operator is implemented as floored division.
Agda will paint f in salmon because it cannot tell if n/2 is smaller than n. I don't know how to tell Agda's termination checker anything. I see in the standard library they have a floored division by 2 and a proof that n/2 < n. However, I still fail to see how to get the termination checker to realize that recursion has been made on a smaller subproblem.
Agda's termination checker only checks for structural recursion (i.e. calls that happen on structurally smaller arguments) and there's no way to establish that certain relation (such as _<_) implies that one of the arguments is structurally smaller.
Digression: Similar problem happens with positivity checker. Consider the standard fix-point data type:
data μ_ (F : Set → Set) : Set where
fix : F (μ F) → μ F
Agda rejects this because F may not be positive in its first argument. But we cannot restrict μ to only take positive type functions, or show that some particular type function is positive.
How do we normally show that a recursive functions terminates? For natural numbers, this is the fact that if the recursive call happens on strictly smaller number, we eventually have to reach zero and the recursion stops; for lists the same holds for its length; for sets we could use the strict subset relation; and so on. Notice that "strictly smaller number" doesn't work for integers.
The property that all these relations share is called well-foundedness. Informally speaking, a relation is well-founded if it doesn't have any infinite descending chains. For example, < on natural numbers is well founded, because for any number n:
n > n - 1 > ... > 2 > 1 > 0
That is, the length of such chain is limited by n + 1.
≤ on natural numbers, however, is not well-founded:
n ≥ n ≥ ... ≥ n ≥ ...
And neither is < on integers:
n > n - 1 > ... > 1 > 0 > -1 > ...
Does this help us? It turns out we can encode what it means for a relation to be well-founded in Agda and then use it to implement your function.
For simplicity, I'm going to bake the _<_ relation into the data type. First of all, we must define what it means for a number to be accessible: n is accessible if all m such that m < n are also accessible. This of course stops at n = 0, because there are no m so that m < 0 and this statement holds trivially.
data Acc (n : ℕ) : Set where
acc : (∀ m → m < n → Acc m) → Acc n
Now, if we can show that all natural numbers are accessible, then we showed that < is well-founded. Why is that so? There must be a finite number of the acc constructors (i.e. no infinite descending chain) because Agda won't let us write infinite recursion. Now, it might seem as if we just pushed the problem back one step further, but writing the well-foundedness proof is actually structurally recursive!
So, with that in mind, here's the definition of < being well-founded:
WF : Set
WF = ∀ n → Acc n
And the well-foundedness proof:
<-wf : WF
<-wf n = acc (go n)
where
go : ∀ n m → m < n → Acc m
go zero m ()
go (suc n) zero _ = acc λ _ ()
go (suc n) (suc m) (s≤s m<n) = acc λ o o<sm → go n o (trans o<sm m<n)
Notice that go is nicely structurally recursive. trans can be imported like this:
open import Data.Nat
open import Relation.Binary
open DecTotalOrder decTotalOrder
using (trans)
Next, we need a proof that ⌊ n /2⌋ ≤ n:
/2-less : ∀ n → ⌊ n /2⌋ ≤ n
/2-less zero = z≤n
/2-less (suc zero) = z≤n
/2-less (suc (suc n)) = s≤s (trans (/2-less n) (right _))
where
right : ∀ n → n ≤ suc n
right zero = z≤n
right (suc n) = s≤s (right n)
And finally, we can write your f function. Notice how it suddenly becomes structurally recursive thanks to Acc: the recursive calls happen on arguments with one acc constructor peeled off.
f : ℕ → ℕ
f n = go _ (<-wf n)
where
go : ∀ n → Acc n → ℕ
go zero _ = 0
go (suc n) (acc a) = go ⌊ n /2⌋ (a _ (s≤s (/2-less _)))
Now, having to work directly with Acc isn't very nice. And that's where Dominique's answer comes in. All this stuff I've written here has already been done in the standard library. It is more general (the Acc data type is actually parametrized over the relation) and it allows you to just use <-rec without having to worry about Acc.
Taking a more closer look, we are actually pretty close to the generic solution. Let's see what we get when we parametrize over the relation. For simplicity I'm not dealing with universe polymorphism.
A relation on A is just a function taking two As and returning Set (we could call it binary predicate):
Rel : Set → Set₁
Rel A = A → A → Set
We can easily generalize Acc by changing the hardcoded _<_ : ℕ → ℕ → Set to an arbitrary relation over some type A:
data Acc {A} (_<_ : Rel A) (x : A) : Set where
acc : (∀ y → y < x → Acc _<_ y) → Acc _<_ x
The definition of well-foundedness changes accordingly:
WellFounded : ∀ {A} → Rel A → Set
WellFounded _<_ = ∀ x → Acc _<_ x
Now, since Acc is an inductive data type like any other, we should be able to write its eliminator. For inductive types, this is a fold (much like foldr is eliminator for lists) - we tell the eliminator what to do with each constructor case and the eliminator applies this to the whole structure.
In this case, we'll do just fine with the simple variant:
foldAccSimple : ∀ {A} {_<_ : Rel A} {R : Set} →
(∀ x → (∀ y → y < x → R) → R) →
∀ z → Acc _<_ z → R
foldAccSimple {R = R} acc′ = go
where
go : ∀ z → Acc _ z → R
go z (acc a) = acc′ z λ y y<z → go y (a y y<z)
If we know that _<_ is well-founded, we can skip the Acc _<_ z argument completly, so let's write small convenience wrapper:
recSimple : ∀ {A} {_<_ : Rel A} → WellFounded _<_ → {R : Set} →
(∀ x → (∀ y → y < x → R) → R) →
A → R
recSimple wf acc′ z = foldAccSimple acc′ z (wf z)
And finally:
<-wf : WellFounded _<_
<-wf = {- same definition -}
<-rec = recSimple <-wf
f : ℕ → ℕ
f = <-rec go
where
go : ∀ n → (∀ m → m < n → ℕ) → ℕ
go zero _ = 0
go (suc n) r = r ⌊ n /2⌋ (s≤s (/2-less _))
And indeed, this looks (and works) almost like the one in the standard library!
Here's the fully dependent version in case you are wondering:
foldAcc : ∀ {A} {_<_ : Rel A} (P : A → Set) →
(∀ x → (∀ y → y < x → P y) → P x) →
∀ z → Acc _<_ z → P z
foldAcc P acc′ = go
where
go : ∀ z → Acc _ z → P z
go _ (acc a) = acc′ _ λ _ y<z → go _ (a _ y<z)
rec : ∀ {A} {_<_ : Rel A} → WellFounded _<_ →
(P : A → Set) → (∀ x → (∀ y → y < x → P y) → P x) →
∀ z → P z
rec wf P acc′ z = foldAcc P acc′ _ (wf z)
I would like to offer a slightly different answer than the ones given above. In particular, I want to suggest that instead of trying to somehow convince the termination checker that actually, no, this recursion is perfectly fine, we should instead try to reify the well-founded-ness so that the recursion is manifestly fine in virtue of being structural.
The idea here is that the problem comes from being unable to see that n / 2 is somehow a "part" of n. Structural recursion wants to break a thing into its immediate parts, but the way that n / 2 is a "part" of n is that we drop every other suc. But it's not obvious up front how many to drop, we have to look around and try to line things up. What would be nice is if we had some type that had constructors for "multiple" sucs.
To make the problem slightly more interesting, let's instead try to define the function that behaves like
f : ℕ → ℕ
f 0 = 0
f (suc n) = 1 + (f (n / 2))
that is to say, it should be the case that
f n = ⌈ log₂ (n + 1) ⌉
Now naturally the above definition won't work, for the same reasons your f won't. But let's pretend that it did, and let's explore the "path", so to speak, that the argument would take through the natural numbers. Suppose we look at n = 8:
f 8 = 1 + f 4 = 1 + 1 + f 2 = 1 + 1 + 1 + f 1 = 1 + 1 + 1 + 1 + f 0 = 1 + 1 + 1 + 1 + 0 = 4
so the "path" is 8 -> 4 -> 2 -> 1 -> 0. What about, say, 11?
f 11 = 1 + f 5 = 1 + 1 + f 2 = ... = 4
so the "path" is 11 -> 5 -> 2 -> 1 -> 0.
Well naturally what's going on here is that at each step we're either dividing by 2, or subtracting one and dividing by 2. Every naturally number greater than 0 can be decomposed uniquely in this fashion. If it's even, divide by two and proceed, if it's odd, subtract one and divide by two and proceed.
So now we can see exactly what our data type should look like. We need a type that has a constructor that means "twice as many suc's" and another that means "twice as many suc's plus one", as well as of course a constructor that means "zero sucs":
data Decomp : ℕ → Set where
zero : Decomp zero
2*_ : ∀ {n} → Decomp n → Decomp (n * 2)
2*_+1 : ∀ {n} → Decomp n → Decomp (suc (n * 2))
We can now define the function that decomposes a natural number into the Decomp that corresponds to it:
decomp : (n : ℕ) → Decomp n
decomp zero = zero
decomp (suc n) = decomp n +1
It helps to define +1 for Decomps:
_+1 : {n : ℕ} → Decomp n → Decomp (suc n)
zero +1 = 2* zero +1
(2* d) +1 = 2* d +1
(2* d +1) +1 = 2* (d +1)
Given a Decomp, we can flatten it down into a natural number that ignores the distinctions between 2*_ and 2*_+1:
flatten : {n : ℕ} → Decomp n → ℕ
flatten zero = zero
flatten (2* p) = suc (flatten p)
flatten (2* p +1 = suc (flatten p)
And now it's trivial to define f:
f : ℕ → ℕ
f n = flatten (decomp n)
This happily passes the termination checker with no trouble, because we're never actually recursing on the problematic n / 2. Instead, we convert the number into a format that directly represents its path through the number space in a structurally recursive way.
Edit It occurred to me only a little while ago that Decomp is a little-endian representation of binary numbers. 2*_ is "append 0 to the end/shift left 1 bit" and 2*_+1 is "append 1 to the end/shift left 1 bit and add one". So the above code is really about showing that binary numbers are structurally recursive wrt dividing by 2, which they ought to be! That makes it much easier to understand, I think, but I don't want to change what I wrote already, so we could instead do some renaming here: Decomp ~> Binary, 2*_ ~> _,zero, 2*_+1 ~> _,one, decomp ~> natToBin, flatten ~> countBits.
After accepting Vitus' answer, I discovered a different way to accomplish the goal of proving a function terminates in Agda, namely using "sized types." I am providing my answer here because it seems acceptable, and also for critique of any weak points of this answer.
Sized types are described:
http://arxiv.org/pdf/1012.4896.pdf
They are implemented in Agda, not only MiniAgda; see here: http://www2.tcs.ifi.lmu.de/~abel/talkAIM2008Sendai.pdf.
The idea is to augment the data type with a size that allows the typechecker to more easily prove termination. Size is defined in the standard library.
open import Size
We define sized natural numbers:
data Nat : {i : Size} \to Set where
zero : {i : Size} \to Nat {\up i}
succ : {i : Size} \to Nat {i} \to Nat {\up i}
Next, we define predecessor and subtraction (monus):
pred : {i : Size} → Nat {i} → Nat {i}
pred .{↑ i} (zero {i}) = zero {i}
pred .{↑ i} (succ {i} n) = n
sub : {i : Size} → Nat {i} → Nat {∞} → Nat {i}
sub .{↑ i} (zero {i}) n = zero {i}
sub .{↑ i} (succ {i} m) zero = succ {i} m
sub .{↑ i} (succ {i} m) (succ n) = sub {i} m n
Now, we may define division via Euclid's algorithm:
div : {i : Size} → Nat {i} → Nat → Nat {i}
div .{↑ i} (zero {i}) n = zero {i}
div .{↑ i} (succ {i} m) n = succ {i} (div {i} (sub {i} m n) n)
data ⊥ : Set where
record ⊤ : Set where
notZero : Nat → Set
notZero zero = ⊥
notZero _ = ⊤
We give division for nonzero denominators.
If the denominator is nonzero, then it is of the form, b+1. We then do
divPos a (b+1) = div a b
Since div a b returns ceiling (a/(b+1)).
divPos : {i : Size} → Nat {i} → (m : Nat) → (notZero m) → Nat {i}
divPos a (succ b) p = div a b
divPos a zero ()
As auxiliary:
div2 : {i : Size} → Nat {i} → Nat {i}
div2 n = divPos n (succ (succ zero)) (record {})
Now we can define a divide and conquer method for computing the n-th Fibonacci number.
fibd : {i : Size} → Nat {i} → Nat
fibd zero = zero
fibd (succ zero) = succ zero
fibd (succ (succ zero)) = succ zero
fibd (succ n) with even (succ n)
fibd .{↑ i} (succ {i} n) | true =
let
-- When m=n+1, the input, is even, we set k = m/2
-- Note, ceil(m/2) = ceil(n/2)
k = div2 {i} n
fib[k-1] = fibd {i} (pred {i} k)
fib[k] = fibd {i} k
fib[k+1] = fib[k-1] + fib[k]
in
(fib[k+1] * fib[k]) + (fib[k] * fib[k-1])
fibd .{↑ i} (succ {i} n) | false =
let
-- When m=n+1, the input, is odd, we set k = n/2 = (m-1)/2.
k = div2 {i} n
fib[k-1] = fibd {i} (pred {i} k)
fib[k] = fibd {i} k
fib[k+1] = fib[k-1] + fib[k]
in
(fib[k+1] * fib[k+1]) + (fib[k] * fib[k])
You cannot do this directly: Agda's termination checker only considers recursion ok on arguments that are syntactically smaller. However, the Agda standard library provides a few modules for proving termination using a well-founded order between the arguments of the functions. The standard order on natural numbers is such an order and can be used here.
Using the code in Induction.*, you can write your function as follows:
open import Data.Nat
open import Induction.WellFounded
open import Induction.Nat
s≤′s : ∀ {n m} → n ≤′ m → suc n ≤′ suc m
s≤′s ≤′-refl = ≤′-refl
s≤′s (≤′-step lt) = ≤′-step (s≤′s lt)
proof : ∀ n → ⌊ n /2⌋ ≤′ n
proof 0 = ≤′-refl
proof 1 = ≤′-step (proof zero)
proof (suc (suc n)) = ≤′-step (s≤′s (proof n))
f : ℕ → ℕ
f = <-rec (λ _ → ℕ) helper
where
helper : (n : ℕ) → (∀ y → y <′ n → ℕ) → ℕ
helper 0 rec = 0
helper (suc n) rec = rec ⌊ n /2⌋ (s≤′s (proof n))
I found an article with some explanation here. But there may be better references out there.
A similar question appeared on the Agda mailing-list a few weeks ago and the consensus seemed to be to inject the Data.Nat element into Data.Bin and then use structural recursion on this representation which is well-suited for the job at hand.
You can find the whole thread here : http://comments.gmane.org/gmane.comp.lang.agda/5690
You can avoid using well-founded recursion. Let's say you want a function, that applies ⌊_/2⌋ to a number, until it reaches 0, and collects the results. With the {-# TERMINATING #-} pragma it can be defined like this:
{-# TERMINATING #-}
⌊_/2⌋s : ℕ -> List ℕ
⌊_/2⌋s 0 = []
⌊_/2⌋s n = n ∷ ⌊ ⌊ n /2⌋ /2⌋s
The second clause is equivalent to
⌊_/2⌋s n = n ∷ ⌊ n ∸ (n ∸ ⌊ n /2⌋) /2⌋s
It's possible to make ⌊_/2⌋s structurally recursive by inlining this substraction:
⌊_/2⌋s : ℕ -> List ℕ
⌊_/2⌋s = go 0 where
go : ℕ -> ℕ -> List ℕ
go _ 0 = []
go 0 (suc n) = suc n ∷ go (n ∸ ⌈ n /2⌉) n
go (suc i) (suc n) = go i n
go (n ∸ ⌈ n /2⌉) n is a simplified version of go (suc n ∸ ⌊ suc n /2⌋ ∸ 1) n
Some tests:
test-5 : ⌊ 5 /2⌋s ≡ 5 ∷ 2 ∷ 1 ∷ []
test-5 = refl
test-25 : ⌊ 25 /2⌋s ≡ 25 ∷ 12 ∷ 6 ∷ 3 ∷ 1 ∷ []
test-25 = refl
Now let's say you want a function, that applies ⌊_/2⌋ to a number, until it reaches 0, and sums the results. It's simply
⌊_/2⌋sum : ℕ -> ℕ
⌊ n /2⌋sum = go ⌊ n /2⌋s where
go : List ℕ -> ℕ
go [] = 0
go (n ∷ ns) = n + go ns
So we can just run our recursion on a list, that contains values, produced by the ⌊_/2⌋s function.
More concise version is
⌊ n /2⌋sum = foldr _+_ 0 ⌊ n /2⌋s
And back to the well-foundness.
open import Function
open import Relation.Nullary
open import Relation.Binary
open import Induction.WellFounded
open import Induction.Nat
calls : ∀ {a b ℓ} {A : Set a} {_<_ : Rel A ℓ} {guarded : A -> Set b}
-> (f : A -> A)
-> Well-founded _<_
-> (∀ {x} -> guarded x -> f x < x)
-> (∀ x -> Dec (guarded x))
-> A
-> List A
calls {A = A} {_<_} f wf smaller dec-guarded x = go (wf x) where
go : ∀ {x} -> Acc _<_ x -> List A
go {x} (acc r) with dec-guarded x
... | no _ = []
... | yes g = x ∷ go (r (f x) (smaller g))
This function does the same as the ⌊_/2⌋s function, i.e. produces values for recursive calls, but for any function, that satisfies certain conditions.
Look at the definition of go. If x is not guarded, then return []. Otherwise prepend x and call go on f x (we could write go {x = f x} ...), which is structurally smaller.
We can redefine ⌊_/2⌋s in terms of calls:
⌊_/2⌋s : ℕ -> List ℕ
⌊_/2⌋s = calls {guarded = ?} ⌊_/2⌋ ? ? ?
⌊ n /2⌋s returns [], only when n is 0, so guarded = λ n -> n > 0.
Our well-founded relation is based on _<′_ and defined in the Induction.Nat module as <-well-founded.
So we have
⌊_/2⌋s = calls {guarded = λ n -> n > 0} ⌊_/2⌋ <-well-founded {!!} {!!}
The type of the next hole is {x : ℕ} → x > 0 → ⌊ x /2⌋ <′ x
We can easily prove this proposition:
open import Data.Nat.Properties
suc-⌊/2⌋-≤′ : ∀ n -> ⌊ suc n /2⌋ ≤′ n
suc-⌊/2⌋-≤′ 0 = ≤′-refl
suc-⌊/2⌋-≤′ (suc n) = s≤′s (⌊n/2⌋≤′n n)
>0-⌊/2⌋-<′ : ∀ {n} -> n > 0 -> ⌊ n /2⌋ <′ n
>0-⌊/2⌋-<′ {suc n} (s≤s z≤n) = s≤′s (suc-⌊/2⌋-≤′ n)
The type of the last hole is (x : ℕ) → Dec (x > 0), we can fill it by _≤?_ 1.
And the final definition is
⌊_/2⌋s : ℕ -> List ℕ
⌊_/2⌋s = calls ⌊_/2⌋ <-well-founded >0-⌊/2⌋-<′ (_≤?_ 1)
Now you can recurse on a list, produced by ⌊_/2⌋s, without any termination issues.
I encountered this sort of problem when trying to write a quick sort function in Agda.
While other answers seem to explain the problem and solutions more generally, coming from a CS background, I think the following wording would be more accessible for certain readers:
The problem of working with the Agda termination checker comes down to how we can internalize the termination checking process.
Suppose we want to define a function
func : Some-Recursively-Defined-Type → A
func non-recursive-case = some-a
func (recursive-case n) = some-other-func (func (f n)) (func (g n)) ...
In many of the cases, we the writers know f n and g n are going to be smaller than recursive-case n. Furthermore, it is not like the proofs for these being smaller are super difficult. The problem is more about how we can communicate this knowledge to Agda.
It turns out we can do this by adding a timer argument to the definition.
Timer : Type
Timer = Nat
measure : Some-Recursively-Defined-Type → Timer
-- this function returns an upper-bound of how many steps left to terminate
-- the estimate should be tight enough for the non-recursive cases that
-- given those estimates,
-- pattern matching on recursive cases is obviously impossible
measure = {! !}
func-aux :
(timer : Timer) -- the timer,
(actual-arguments : Some-Recursively-Defined-Type)
(timer-bounding : measure actual-arguments ≤ timer)
→ A
func-aux zero non-recursive-case prf = a
-- the prf should force args to only pattern match to the non-recursive cases
func-aux (succ t) non-recursive-case prf = a
func-aux (succ t) (recursive-case n) prf =
some-other-func (func-aux t (f n) prf') (func-aux t (g n) prf'') ... where
prf' : measure (f n) ≤ t
prf' = {! !}
prf'' : measure (g n) ≤ t
prf'' = {! !}
With these at hand, we can define the function we want as something like the following :
func : Some-Recursively-Defined-Type → A
func x with measure x
func x | n = func-aux n x (≤-is-reflexive n)
Caveat
I have not taken into account anything about whether the computation would be efficient.
While Timer type is not restricted to be Nat (but for all types with which we have a strong enough order relation to work with), I think it is pretty safe to say we don't gain much even if we consider such generality.

Resources