2022-03-27 15:05:20 +03:00
|
|
|
||| Defines well-founded induction and recursion.
|
|
|
|
|||
|
|
|
|
||| Induction is way to consume elements of recursive types where each step of
|
|
|
|
||| the computation has access to the previous steps.
|
|
|
|
||| Normally, induction is structural: the previous steps are the children of
|
|
|
|
||| the current element.
|
|
|
|
||| Well-founded induction generalises this as follows: each step has access to
|
|
|
|
||| any value that is less than the current element, based on a relation.
|
|
|
|
|||
|
|
|
|
||| Well-founded induction is implemented in terms of accessibility: an element
|
|
|
|
||| is accessible (with respect to a given relation) if every element less than
|
|
|
|
||| it is also accessible. This can only terminate at minimum elements.
|
|
|
|
|||
|
|
|
|
||| This corresponds to the idea that for a computation to terminate, there
|
|
|
|
||| must be a finite path to an element from which there is no way to recurse.
|
|
|
|
|||
|
|
|
|
||| Many instances of well-founded induction are actually induction over
|
|
|
|
||| natural numbers that are derived from the elements being inducted over. For
|
|
|
|
||| this purpose, the `Sized` interface and related functions are provided.
|
2020-05-18 15:59:07 +03:00
|
|
|
module Control.WellFounded
|
|
|
|
|
2021-07-09 11:06:27 +03:00
|
|
|
import Control.Relation
|
2020-05-18 15:59:07 +03:00
|
|
|
import Data.Nat
|
|
|
|
|
2021-06-09 01:05:10 +03:00
|
|
|
%default total
|
|
|
|
|
2022-03-27 15:05:20 +03:00
|
|
|
||| A value is accessible if everything smaller than it is also accessible.
|
2020-05-18 15:59:07 +03:00
|
|
|
public export
|
|
|
|
data Accessible : (rel : a -> a -> Type) -> (x : a) -> Type where
|
|
|
|
Access : (rec : (y : a) -> rel y x -> Accessible rel y) ->
|
|
|
|
Accessible rel x
|
|
|
|
|
2022-03-27 15:05:20 +03:00
|
|
|
||| A relation is well-founded if every element is accessible.
|
2020-05-18 15:59:07 +03:00
|
|
|
public export
|
2020-12-11 14:58:26 +03:00
|
|
|
interface WellFounded a rel where
|
2020-05-18 15:59:07 +03:00
|
|
|
wellFounded : (x : a) -> Accessible rel x
|
|
|
|
|
2022-03-27 15:05:20 +03:00
|
|
|
||| Simply-typed recursion based on accessibility.
|
|
|
|
|||
|
|
|
|
||| The recursive step for an element has access to all elements smaller than
|
|
|
|
||| it. The recursion will therefore halt when it reaches a minimum element.
|
|
|
|
|||
|
|
|
|
||| This may sometimes improve type-inference, compared to `accInd`.
|
2020-05-18 15:59:07 +03:00
|
|
|
export
|
|
|
|
accRec : {0 rel : (arg1 : a) -> (arg2 : a) -> Type} ->
|
|
|
|
(step : (x : a) -> ((y : a) -> rel y x -> b) -> b) ->
|
|
|
|
(z : a) -> (0 acc : Accessible rel z) -> b
|
|
|
|
accRec step z (Access f) =
|
|
|
|
step z $ \yarg, lt => accRec step yarg (f yarg lt)
|
|
|
|
|
2022-03-27 15:05:20 +03:00
|
|
|
||| Depedently-typed induction based on accessibility.
|
|
|
|
|||
|
|
|
|
||| The recursive step for an element has access to all elements smaller than
|
|
|
|
||| it. The recursion will therefore halt when it reaches a minimum element.
|
2020-05-18 15:59:07 +03:00
|
|
|
export
|
|
|
|
accInd : {0 rel : a -> a -> Type} -> {0 P : a -> Type} ->
|
|
|
|
(step : (x : a) -> ((y : a) -> rel y x -> P y) -> P x) ->
|
|
|
|
(z : a) -> (0 acc : Accessible rel z) -> P z
|
|
|
|
accInd step z (Access f) =
|
|
|
|
step z $ \y, lt => accInd step y (f y lt)
|
|
|
|
|
2022-03-27 15:05:20 +03:00
|
|
|
||| Simply-typed recursion based on well-founded-ness.
|
|
|
|
|||
|
|
|
|
||| This is `accRec` applied to accessibility derived from a `WellFounded`
|
|
|
|
||| instance.
|
2020-05-18 15:59:07 +03:00
|
|
|
export
|
2021-02-11 16:18:13 +03:00
|
|
|
wfRec : (0 _ : WellFounded a rel) =>
|
2020-05-18 15:59:07 +03:00
|
|
|
(step : (x : a) -> ((y : a) -> rel y x -> b) -> b) ->
|
|
|
|
a -> b
|
|
|
|
wfRec step x = accRec step x (wellFounded {rel} x)
|
|
|
|
|
2022-03-27 15:05:20 +03:00
|
|
|
||| Depedently-typed induction based on well-founded-ness.
|
|
|
|
|||
|
|
|
|
||| This is `accInd` applied to accessibility derived from a `WellFounded`
|
|
|
|
||| instance.
|
2020-05-18 15:59:07 +03:00
|
|
|
export
|
2021-02-11 16:18:13 +03:00
|
|
|
wfInd : (0 _ : WellFounded a rel) => {0 P : a -> Type} ->
|
2020-05-18 15:59:07 +03:00
|
|
|
(step : (x : a) -> ((y : a) -> rel y x -> P y) -> P x) ->
|
|
|
|
(myz : a) -> P myz
|
|
|
|
wfInd step myz = accInd step myz (wellFounded {rel} myz)
|
|
|
|
|
2022-03-27 15:05:20 +03:00
|
|
|
||| Types that have a concept of size. The size must be a natural number.
|
2020-05-18 15:59:07 +03:00
|
|
|
public export
|
|
|
|
interface Sized a where
|
2021-07-26 21:12:05 +03:00
|
|
|
constructor MkSized
|
|
|
|
total size : a -> Nat
|
2020-05-18 15:59:07 +03:00
|
|
|
|
2022-03-27 15:05:20 +03:00
|
|
|
||| A relation based on the size of the values.
|
2020-05-18 15:59:07 +03:00
|
|
|
public export
|
|
|
|
Smaller : Sized a => a -> a -> Type
|
2021-07-26 21:12:05 +03:00
|
|
|
Smaller = \x, y => size x `LT` size y
|
2020-05-18 15:59:07 +03:00
|
|
|
|
2022-03-27 15:05:20 +03:00
|
|
|
||| Values that are accessible based on their size.
|
2020-05-18 15:59:07 +03:00
|
|
|
public export
|
|
|
|
SizeAccessible : Sized a => a -> Type
|
|
|
|
SizeAccessible = Accessible Smaller
|
|
|
|
|
2022-03-27 15:05:20 +03:00
|
|
|
||| Any value of a sized type is accessible, since naturals are well-founded.
|
2020-05-18 15:59:07 +03:00
|
|
|
export
|
|
|
|
sizeAccessible : Sized a => (x : a) -> SizeAccessible x
|
|
|
|
sizeAccessible x = Access (acc $ size x)
|
|
|
|
where
|
|
|
|
acc : (sizeX : Nat) -> (y : a) -> (size y `LT` sizeX) -> SizeAccessible y
|
|
|
|
acc (S x') y (LTESucc yLEx')
|
2021-11-22 23:10:08 +03:00
|
|
|
= Access $ \z, zLTy => acc x' z $ transitive zLTy yLEx'
|
2020-05-18 15:59:07 +03:00
|
|
|
|
2022-03-27 15:05:20 +03:00
|
|
|
||| Depedently-typed induction based on the size of values.
|
|
|
|
|||
|
|
|
|
||| This is `accInd` applied to accessibility derived from size.
|
2020-05-18 15:59:07 +03:00
|
|
|
export
|
|
|
|
sizeInd : Sized a => {0 P : a -> Type} ->
|
|
|
|
(step : (x : a) -> ((y : a) -> Smaller y x -> P y) -> P x) ->
|
|
|
|
(z : a) ->
|
|
|
|
P z
|
|
|
|
sizeInd step z = accInd step z (sizeAccessible z)
|
|
|
|
|
2022-03-27 15:05:20 +03:00
|
|
|
||| Simply-typed recursion based on the size of values.
|
|
|
|
|||
|
|
|
|
||| This is `recInd` applied to accessibility derived from size.
|
2020-05-18 15:59:07 +03:00
|
|
|
export
|
|
|
|
sizeRec : Sized a =>
|
|
|
|
(step : (x : a) -> ((y : a) -> Smaller y x -> b) -> b) ->
|
|
|
|
(z : a) -> b
|
|
|
|
sizeRec step z = accRec step z (sizeAccessible z)
|
|
|
|
|
|
|
|
export
|
2021-07-26 21:12:05 +03:00
|
|
|
Sized Nat where
|
2021-06-16 17:22:30 +03:00
|
|
|
size = id
|
2020-05-18 15:59:07 +03:00
|
|
|
|
|
|
|
export
|
2021-07-26 21:12:05 +03:00
|
|
|
WellFounded Nat LT where
|
|
|
|
wellFounded = sizeAccessible
|
|
|
|
|
|
|
|
export
|
|
|
|
Sized (List a) where
|
2020-05-18 15:59:07 +03:00
|
|
|
size = length
|
|
|
|
|
|
|
|
export
|
2021-07-26 21:12:05 +03:00
|
|
|
(Sized a, Sized b) => Sized (Pair a b) where
|
2020-05-18 15:59:07 +03:00
|
|
|
size (x,y) = size x + size y
|