@@ -0,0 +1,43 @@
1+> %default total
2+> %access public export
3+> %auto_implicits off
4+
5+> Natural : {F, G : Type -> Type} ->
6+> (Functor F) => (Functor G) =>
7+> (t : {A : Type} -> F A -> G A) ->
8+> Type
9+> Natural {F} {G} t = {A, B : Type} ->
10+> (f : A -> B) ->
11+> (x : F A) ->
12+> t (map f x) = map f (t x)
13+
14+> Monotone : {B, C : Type} -> {F : Type -> Type} -> (Functor F) =>
15+> (LTE_B : B -> B -> Type) ->
16+> (LTE_C : C -> C -> Type) ->
17+> (measure : F B -> C) ->
18+> Type
19+> Monotone {B} {C} {F} LTE_B LTE_C measure =
20+> {A : Type} ->
21+> (f : A -> B) ->
22+> (g : A -> B) ->
23+> (p : (a : A) -> f a `LTE_B` g a) ->
24+> (x : F A) ->
25+> measure (map f x) `LTE_C` measure (map g x)
26+
27+> monotoneNaturalLemma: {B, C : Type} -> {F : Type -> Type} -> (Functor F) =>
28+> (LTE_B : B -> B -> Type) ->
29+> (LTE_C : C -> C -> Type) ->
30+> (measure : F B -> C) ->
31+> Monotone LTE_B LTE_C measure ->
32+> (t : {A : Type} -> F A -> F A) ->
33+> Natural t ->
34+> Monotone LTE_B LTE_C (measure . t)
35+> monotoneNaturalLemma {B} {C} {F} LTE_B LTE_C m mm t nt = mmt where
36+> mmt : {A : Type} ->
37+> (f : A -> B) ->
38+> (g : A -> B) ->
39+> (p : (a : A) -> f a `LTE_B` g a) ->
40+> (x : F A) ->
41+> m (t {A = B} (map f x)) `LTE_C` m (t {A = B} (map g x))
42+> mmt = ?kika
43+