Defining a function to a subset of the codomain - functional-programming

I am trying to define the image restriction of a function
f : A → B as f': A → f[A], where f'(a) = f(a) . However, I am not sure how to define it in a lean.
In my opinion, the most intuitive way to define it is:
def fun_to_image {A B: Type*} (f: A → B): A → image f set.univ :=
λ a, f a
However, this gets rejected because (f a) is of type B not (image f set.univ).
I even tried proving that f(a) ∈ (image f univ) . It didn't help:
def fun_to_image (f : A → B) : A → image f univ :=
λ a ,
have h : f a ∈ image f univ :=
exists.intro a
(and.intro trivial (eq.refl (f a))),
f a
The error message is:
type mismatch, term
λ (a : A), f a
has type
A → B
but is expected to have type
A → ↥(f '' univ)
set.univ and image are defined as follows in data.set
def univ : set α :=
λ a, true
def image (f : α → β) (s : set α) : set β :=
{b | ∃ a, a ∈ s ∧ f a = b}
Any idea how this can be done?

You are almost there (-;
There is a little “warning sign” in the error message.
but is expected to have type
A → ↥(f '' univ)
You can see the creepy up-arrow ↥. Let me explain what it means:
As you have recalled, image f set.univ is defined as a subset. Since you are treating it as a type, it is automatically coerced into a so-called subtype: if s : set X, then the corresponding subtype s has terms of the form ⟨x, h⟩ (type these as \< and \> in VScode), where x : X and h : x ∈ s.
This “coercion to type” is indicated by the ↥.
So, to finish your definition, you will have to write ⟨f a, h⟩, instead of f a.
Note that in main library there is also a definition of range (here) which is meant to be used in place of image _ set.univ.
It already comes with (L1167)
def range_factorization (f : ι → β) : ι → range f :=
λ i, ⟨f i, mem_range_self i⟩

Related

Prove recursive function exists using only `nat_ind`

I'm trying to prove the following in Coq:
∀ B: Type, ∀ a: B, ∀ b: nat -> B -> B, ∃ f: nat -> B, f 0 = a ∧ ∀ n: nat, f (S n) = b n (f n).
Which implies that a fairly general class of recursive functions exist. I know that I can construct that function using Fixpoint items or fix expressions, but I want to not use it, and instead use nat_ind defined with this type:
∀ P: nat → Prop, P 0 → (∀ n: nat, P n → P (S n)) → ∀ n: nat, P n
I believe this is possible since nat_ind behaves like a recursion combinator. But I didn't figured it out how to prove it. The problem is that the induction variable is inside of ∃ f guard, and I don't have access to it. I'm able to prove something like this:
∀ B: Type, ∀ a: B, ∀ b: nat -> B -> B, ∀ m: nat,
∃ f: nat -> B, f 0 = a ∧ ∀ n: nat, n < m -> f (S n) = b n (f n)
But it doesn't help in proving the original one I think.
Is it possible to prove the original one without using fix directly? I'm ok with using double negation and other well-known axioms if needed. Using nat_rec and nat_rect is also fine, but only as an opaque axiom. Precisely, using those are fine:
Axiom nat_rec2: ∀ P : nat → Set, P 0 → (∀ n : nat, P n → P (S n)) → ∀ n : nat, P n.
Axiom nat_rect2: ∀ P : nat → Type, P 0 → (∀ n : nat, P n → P (S n)) → ∀ n : nat, P n.
The problem seems to be to obtain recursion from the following axiomatization of nat:
Parameter nat : Type.
Parameter O : nat.
Parameter S : nat -> nat.
Parameter disjoint_O_S : forall n, O <> S n.
Parameter injective_S : forall n n', S n = S n' -> n = n'.
Parameter nat_rect : forall P: nat -> Type, P O -> (forall n: nat, P n -> P (S n)) -> forall n : nat, P n.
Where the main issue is that the nat_rect axiom has no computational behavior, so although we might define a recursor B -> (nat -> B -> B) -> nat -> B as nat_rect (fun _ => B), we can't prove anything about it.
The solution is to first encode the graph of the desired recursive function f as a relation, and then use nat_rect to produce a dependent pair, of a value that is going to be f n with evidence that that value is in the graph of f.
Section Rec.
Context (B : Type) (a : B) (b : nat -> B -> B).
Inductive graph : nat -> B -> Prop :=
| recO : graph O a
| recS n y : graph n y -> graph (S n) (b n y)
.
Lemma graph_fun : forall n, { y | forall y', y = y' <-> graph n y' }.
Proof.
induction n as [ | n IH ] using nat_rect.
- exists a; split.
+ intros <-. constructor.
+ inversion 1; [ reflexivity | ]. contradiction (disjoint_O_S n); auto.
- destruct IH as [y IH]. exists (b n y); split.
+ intros <-. constructor. apply IH. auto.
+ inversion 1; subst. contradiction (disjoint_O_S n); auto.
apply injective_S in H0. subst.
apply IH in H1. subst; auto.
Qed.
Theorem nat_rec : exists (f : nat -> B), f O = a /\ forall n, f (S n) = b n (f n).
Proof.
exists (fun n => proj1_sig (graph_fun n)). split.
- apply (proj2_sig (graph_fun O)). constructor.
- intros n. apply (proj2_sig (graph_fun (S n))).
constructor. apply (proj2_sig (graph_fun n)).
reflexivity.
Qed.
End Rec.
If you have the Prop inductor nat_ind instead of nat_rect, that same technique can be adapted by also assuming the axiom constructive_indefinite_description (which actually lets you reconstruct nat_rect, but here you can more simply apply it at the beginning of graph_fun):
From Coq Require Import IndefiniteDescription.
About constructive_indefinite_description.
(*
constructive_indefinite_description :
forall (A : Type) (P : A->Prop),
(exists x, P x) -> { x : A | P x }.
*)

Understanding Assignment Solution in Agda

Consider the following extracted piece of code for proving the "Unicity of Typing" for variable in Agda:
unicity : ∀ {Γ₁ Γ₂ e τ₁ τ₂} → (Γ₁ ⊢ e ∷ τ₁) → (Γ₂ ⊢ e ∷ τ₂) → (Γ₁ ≈ Γ₂) → (τ₁ ∼ τ₂)
unicity (VarT here) (VarT here) (_ , ( τ∼ , _ )) = τ∼
unicity (VarT here) (VarT (ski`p {α = α} lk2)) (s≡s' , ( _ , _ )) = ⊥-elim (toWitnessFalse α (toWitness` s≡s'))
unicity (VarT (skip {α = α} lk1)) (VarT here) (s'≡s , ( _ , _ )) = ⊥-elim (toWitnessFalse α (toWitness s'≡s))
unicity (VarT (skip lk1)) (VarT (skip lk2)) (_ ,( _ , Γ≈ )) = unicity (VarT lk1) (VarT lk2) Γ≈
I need an explanation on the working of ⊥-elim , toWitnessFalse and toWitness. Also, what do the expressions ⊤ and ⊥ mean/stand for?
⊥ is the empty type, so (in a total, consistent language) you can never construct a value of type ⊥. But this also means that any proposition you can think of, follows from ⊥. This is what ⊥-elim witnesses:
⊥-elim : ∀ {w} {Whatever : Set w} → ⊥ → Whatever
This is very useful in practice because you might be writing proofs under some assumption, and some of those assumptions might be ⊥, or they might be negative statements (A → ⊥ for some A) and you can prove the A as well, etc. Then, what you find out is effectively that you don't have to care about that particular branch anymore, since it is impossible; but then, just because you don't care, you still have to formally satisfy the result type somehow. This is what ⊥-elim gives you.
toWitness's type and related definitions are as follows:
T : Bool → Set
T true = ⊤
T false = ⊥
⌊_⌋ : ∀ {p} {P : Set p} → Dec P → Bool
⌊ yes _ ⌋ = true
⌊ no _ ⌋ = false
True : ∀ {p} {P : Set p} → Dec P → Set
True Q = T ⌊ Q ⌋
toWitness : ∀ {p} {P : Set p} {Q : Dec P} → True Q → P
Given a Q : Dec P, True Q is either ⊤ (if Q = yes _) or ⊥ (if Q = no _). The only way to call toWitness, then, is to have Q say that P is true and pass the trivial unit constructor tt : ⊤; the only other possibility would be to have Q say that P is false, and pass as an argument a ⊥ but as we've seen, that's not possible. In summary, toWitness says that if Q tells us the decision that P holds, then we can get a proof of P from Q.
toWitnessFalse is exactly the same with the roles reversed: if Q tells us the decision that P doesn't hold, then we can get a proof of ¬ P from Q.

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

Preserving functor positivity when going via product vs. vector

In the following code, the definition of μ₁ is accepted by Agda as a strictly positive functor, which makes sense. If I tie the knot via a product, as in μ₂, it is still accepted. However, if I try to go via a vector, as in μ₃, it is not accepted anymore.
data F : Set where
X : F
⟦_⟧₁ : F → Set → Set
⟦ X ⟧₁ A = A
data μ₁ (f : F) : Set where
Fix₁ : ⟦ f ⟧₁ (μ₁ f) → μ₁ f
open import Data.Product
⟦_⟧₂ : F → (Set × Set) → Set
⟦ X₁ ⟧₂ (A , _) = A
open import Data.Unit
data μ₂ (f : F) : Set where
Fix₂ : ⟦ f ⟧₂ (μ₂ f , ⊤) → μ₂ f
open import Data.Nat
open import Data.Vec
⟦_⟧₃ : ∀ {n} → F → Vec Set (suc n) → Set
⟦ X ⟧₃ (A ∷ _) = A
data μ₃ (f : F) : Set where
Fix₃ : ⟦ f ⟧₃ [ μ₃ f ] → μ₃ f
The error message for μ₃ is
μ₃ is not strictly positive, because it occurs
in the third argument to ⟦_⟧₃
in the type of the constructor Fix₃
in the definition of μ₃.
What is the fundamental difference between μ₂ and μ₃? Is there a way to get something like μ₃ working?
I'm mostly guessing. _×_ is a record and Vec is a data. Agda rejects μ₂, when _×_ is defined as a data:
data Pair (A B : Set₁) : Set₁
where pair : A -> B -> Pair A B
⟦_⟧₃ : F → Pair Set Set → Set
⟦ X ⟧₃ (pair A _) = A
data μ₃ (f : F) : Set where
Fix₃ : ⟦ f ⟧₃ (pair (μ₃ f) ⊤) → μ₃ f
Results in "μ₃ is not strictly positive, because it occurs...". But if you define ⟦_⟧₃ as
⟦_⟧₃ : F → Pair Set Set → Set
⟦ X ⟧₃ _ = ⊤
or
⟦_⟧₃ : F → Pair Set Set → Set
⟦ _ ⟧₃ (pair A _) = A
then everything is OK (your μ₂ is a bit misleading, since there is no pattern matching on F too). In the second case Agda just normalizes the expression, since there is no pattern matching on the first argument and the second is in the WHNF, so ⟦_⟧₃ is totally eliminated. But I don't know, how Agda resolves the first case. Something ad hoc, I suppose.
Your μ₂ typechecks, because Agda eliminates pattern matching on records:
map : {A B : Set} {P : A → Set} {Q : B → Set}
(f : A → B) → (∀ {x} → P x → Q (f x)) →
Σ A P → Σ B Q
map f g (x , y) = (f x , g y)
The clause above is internally translated into the following one:
map f g p = (f (Σ.proj₁ p) , g (Σ.proj₂ p))
So it's just like the
⟦_⟧₃ : F → Pair Set Set → Set
⟦ X ⟧₃ _ = ⊤
case.
Also, ⟦_⟧₃ will typecheck, if you remove pattern matching on the first argument.
UPDATE
No, it's not about pattern matching elimination, since this definition
data Pair (A B : Set₁) : Set₁
where pair : A -> B -> Pair A B
fst : ∀ {A B} -> Pair A B -> A
fst (pair x y) = x
⟦_⟧₃ : F → Pair Set Set → Set
⟦ X ⟧₃ p = fst p
data μ₃ (f : F) : Set where
Fix₃ : ⟦ f ⟧₃ (pair (μ₃ f) ⊤) → μ₃ f
is rejected too.

coq --- function power definition

I am interested in how would one define f to the n in Coq:
Basically, as an exercise, I would like to write this definition and then confirm that my
algorithm implements this specification. Inductive definition seems appropriate here, but I was not able to make it clean as above. What would be a clean Coq implementation of the above?
With the pow_func function that gallais defined, you can state your specification as lemmas, such as:
Lemma pow_func0: forall (A:Type) (f: A -> A) (x: A), pow_fun f O x = f x.
and
Lemma pow_funcS: forall (n:nat) (A: Type) (f: A->A) (x:A), pow_fun f (S n) x = f (pow_fun f n x).
The proof should be trivial by unfolding the definition
Inductive is used to define types closed under some operations; this is not what you are looking for here. What you want to build is a recursive function iterating over n. This can be done using the Fixpoint keyword:
Fixpoint pow_func {A : Type} (f : A -> A) (n : nat) (a : A) : A :=
match n with
| O => f a
| S n => f (pow_func f n a)
end.
If you want a nicer syntax for this function, you can introduce a Notation:
Notation "f ^ n" := (pow_func f n).
However, note that this is not a well-behaved definition of a notion of power: if you compose f ^ m and f ^ n, you don't get f ^ (m + n) but rather f ^ (1 + m + n). To fix that, you should pick the base case f ^ 0 to be the neutral element for composition id rather than f itself. Which would give you:
Fixpoint pow_func' {A : Type} (f : A -> A) (n : nat) (a : A) : A :=
match n with
| O => a
| S n => f (pow_func' f n a)
end.

Resources