87 lines
2.2 KiB
Idris
87 lines
2.2 KiB
Idris
module Quox.NatExtra
|
|
|
|
import public Data.Nat
|
|
import public Data.Nat.Views
|
|
import Data.Nat.Division
|
|
import Data.SnocList
|
|
import Data.Vect
|
|
import Syntax.PreorderReasoning
|
|
|
|
%default total
|
|
|
|
|
|
public export
|
|
data LTE' : Nat -> Nat -> Type where
|
|
LTERefl : LTE' n n
|
|
LTESuccR : LTE' m n -> LTE' m (S n)
|
|
%builtin Natural LTE'
|
|
|
|
public export %hint
|
|
lteZero' : {n : Nat} -> LTE' 0 n
|
|
lteZero' {n = 0} = LTERefl
|
|
lteZero' {n = S n} = LTESuccR lteZero'
|
|
|
|
public export %hint
|
|
lteSucc' : LTE' m n -> LTE' (S m) (S n)
|
|
lteSucc' LTERefl = LTERefl
|
|
lteSucc' (LTESuccR p) = LTESuccR $ lteSucc' p
|
|
|
|
public export
|
|
fromLte : {n : Nat} -> LTE m n -> LTE' m n
|
|
fromLte LTEZero = lteZero'
|
|
fromLte (LTESucc p) = lteSucc' $ fromLte p
|
|
|
|
public export
|
|
toLte : {n : Nat} -> m `LTE'` n -> m `LTE` n
|
|
toLte LTERefl = reflexive
|
|
toLte (LTESuccR p) = lteSuccRight (toLte p)
|
|
|
|
|
|
private
|
|
0 baseNZ : n `GTE` 2 => NonZero n
|
|
baseNZ @{LTESucc _} = SIsNonZero
|
|
|
|
parameters {base : Nat} {auto 0 _ : base `GTE` 2} (chars : Vect base Char)
|
|
private
|
|
showAtBase' : List Char -> Nat -> List Char
|
|
showAtBase' acc 0 = acc
|
|
showAtBase' acc k =
|
|
let dig = natToFinLT (modNatNZ k base baseNZ) @{boundModNatNZ {}} in
|
|
showAtBase' (index dig chars :: acc)
|
|
(assert_smaller k $ divNatNZ k base baseNZ)
|
|
|
|
export
|
|
showAtBase : Nat -> String
|
|
showAtBase = pack . showAtBase' []
|
|
|
|
export
|
|
showHex : Nat -> String
|
|
showHex = showAtBase $ fromList $ unpack "0123456789ABCDEF"
|
|
|
|
|
|
export
|
|
0 notEvenOdd : (a, b : Nat) -> Not (a + a = S (b + b))
|
|
notEvenOdd 0 b prf = absurd prf
|
|
notEvenOdd (S a) b prf =
|
|
notEvenOdd b a $ Calc $
|
|
|~ b + b
|
|
~~ a + S a ..<(inj S prf)
|
|
~~ S (a + a) ..<(plusSuccRightSucc {})
|
|
|
|
export
|
|
0 doubleInj : (m, n : Nat) -> m + m = n + n -> m = n
|
|
doubleInj 0 0 _ = Refl
|
|
doubleInj (S m) (S n) prf =
|
|
cong S $ doubleInj m n $
|
|
inj S $ Calc $
|
|
|~ S (m + m)
|
|
~~ m + S m ...(plusSuccRightSucc {})
|
|
~~ n + S n ...(inj S prf)
|
|
~~ S (n + n) ..<(plusSuccRightSucc {})
|
|
|
|
export
|
|
0 halfDouble : (n : Nat) -> half (n + n) = HalfEven n
|
|
halfDouble n with (half (n + n)) | (n + n) proof nn
|
|
_ | HalfOdd k | S (k + k) = void $ notEvenOdd n k nn
|
|
_ | HalfEven k | k + k = rewrite doubleInj n k nn in Refl
|