Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Menu
Open sidebar
Simon Spies
stdpp
Commits
b0f5f6e6
Commit
b0f5f6e6
authored
Jun 17, 2013
by
Robbert Krebbers
Browse files
Type classes for finite and countable types.
parent
1c177c39
Changes
2
Hide whitespace changes
Inline
Side-by-side
theories/countable.v
0 → 100644
View file @
b0f5f6e6
Require
Export
list
.
Local
Obligation
Tactic
:
=
idtac
.
Local
Open
Scope
positive
.
Class
Countable
A
`
{
∀
x
y
:
A
,
Decision
(
x
=
y
)}
:
=
{
encode
:
A
→
positive
;
decode
:
positive
→
option
A
;
decode_encode
x
:
decode
(
encode
x
)
=
Some
x
}.
Definition
encode_nat
`
{
Countable
A
}
(
x
:
A
)
:
nat
:
=
pred
(
Pos
.
to_nat
(
encode
x
)).
Definition
decode_nat
`
{
Countable
A
}
(
i
:
nat
)
:
option
A
:
=
decode
(
Pos
.
of_nat
(
S
i
)).
Lemma
decode_encode_nat
`
{
Countable
A
}
x
:
decode_nat
(
encode_nat
x
)
=
Some
x
.
Proof
.
pose
proof
(
Pos2Nat
.
is_pos
(
encode
x
)).
unfold
decode_nat
,
encode_nat
.
rewrite
Nat
.
succ_pred
by
lia
.
by
rewrite
Pos2Nat
.
id
,
decode_encode
.
Qed
.
Section
choice
.
Context
`
{
Countable
A
}
(
P
:
A
→
Prop
)
`
{
∀
x
,
Decision
(
P
x
)}.
Inductive
choose_step
:
relation
positive
:
=
|
choose_step_None
{
p
}
:
decode
p
=
None
→
choose_step
(
Psucc
p
)
p
|
choose_step_Some
{
p
x
}
:
decode
p
=
Some
x
→
¬
P
x
→
choose_step
(
Psucc
p
)
p
.
Lemma
choose_step_acc
:
(
∃
x
,
P
x
)
→
Acc
choose_step
1
%
positive
.
Proof
.
intros
[
x
Hx
].
cut
(
∀
i
p
,
i
≤
encode
x
→
1
+
encode
x
=
p
+
i
→
Acc
choose_step
p
).
{
intros
help
.
by
apply
(
help
(
encode
x
)).
}
induction
i
as
[|
i
IH
]
using
Pos
.
peano_ind
;
intros
p
??.
{
constructor
.
intros
j
.
assert
(
p
=
encode
x
)
by
lia
;
subst
.
inversion
1
as
[?
Hd
|??
Hd
]
;
subst
;
rewrite
decode_encode
in
Hd
;
congruence
.
}
constructor
.
intros
j
.
inversion
1
as
[?
Hd
|?
y
Hd
]
;
subst
;
auto
with
lia
.
Qed
.
Fixpoint
choose_go
{
i
}
(
acc
:
Acc
choose_step
i
)
:
A
:
=
match
Some_dec
(
decode
i
)
with
|
inleft
(
x
↾
Hx
)
=>
match
decide
(
P
x
)
with
|
left
_
=>
x
|
right
H
=>
choose_go
(
Acc_inv
acc
(
choose_step_Some
Hx
H
))
end
|
inright
H
=>
choose_go
(
Acc_inv
acc
(
choose_step_None
H
))
end
.
Fixpoint
choose_go_correct
{
i
}
(
acc
:
Acc
choose_step
i
)
:
P
(
choose_go
acc
).
Proof
.
destruct
acc
;
simpl
.
repeat
case_match
;
auto
.
Qed
.
Fixpoint
choose_go_pi
{
i
}
(
acc1
acc2
:
Acc
choose_step
i
)
:
choose_go
acc1
=
choose_go
acc2
.
Proof
.
destruct
acc1
,
acc2
;
simpl
;
repeat
case_match
;
auto
.
Qed
.
Definition
choose
(
H
:
∃
x
,
P
x
)
:
A
:
=
choose_go
(
choose_step_acc
H
).
Definition
choose_correct
(
H
:
∃
x
,
P
x
)
:
P
(
choose
H
)
:
=
choose_go_correct
_
.
Definition
choose_pi
(
H1
H2
:
∃
x
,
P
x
)
:
choose
H1
=
choose
H2
:
=
choose_go_pi
_
_
.
Definition
choice
(
HA
:
∃
x
,
P
x
)
:
{
x
|
P
x
}
:
=
_
↾
choose_correct
HA
.
End
choice
.
Lemma
surjective_cancel
`
{
Countable
A
}
`
{
∀
x
y
:
B
,
Decision
(
x
=
y
)}
(
f
:
A
→
B
)
`
{!
Surjective
(=)
f
}
:
{
g
:
B
→
A
&
Cancel
(=)
f
g
}.
Proof
.
exists
(
λ
y
,
choose
(
λ
x
,
f
x
=
y
)
(
surjective
f
y
)).
intros
y
.
by
rewrite
(
choose_correct
_
(
surjective
f
y
)).
Qed
.
(** ** Instances *)
Program
Instance
option_countable
`
{
Countable
A
}
:
Countable
(
option
A
)
:
=
{|
encode
o
:
=
match
o
with
None
=>
1
|
Some
x
=>
Pos
.
succ
(
encode
x
)
end
;
decode
p
:
=
if
decide
(
p
=
1
)
then
Some
None
else
Some
<$>
decode
(
Pos
.
pred
p
)
|}.
Next
Obligation
.
intros
???
[
x
|]
;
simpl
;
repeat
case_decide
;
auto
with
lia
.
by
rewrite
Pos
.
pred_succ
,
decode_encode
.
Qed
.
Program
Instance
sum_countable
`
{
Countable
A
}
`
{
Countable
B
}
:
Countable
(
A
+
B
)%
type
:
=
{|
encode
xy
:
=
match
xy
with
inl
x
=>
(
encode
x
)~
0
|
inr
y
=>
(
encode
y
)~
1
end
;
decode
p
:
=
match
p
with
|
1
=>
None
|
p
~
0
=>
inl
<$>
decode
p
|
p
~
1
=>
inr
<$>
decode
p
end
|}.
Next
Obligation
.
by
intros
??????
[
x
|
y
]
;
simpl
;
rewrite
decode_encode
.
Qed
.
Fixpoint
prod_encode_fst
(
p
:
positive
)
:
positive
:
=
match
p
with
|
1
=>
1
|
p
~
0
=>
(
prod_encode_fst
p
)~
0
~
0
|
p
~
1
=>
(
prod_encode_fst
p
)~
0
~
1
end
.
Fixpoint
prod_encode_snd
(
p
:
positive
)
:
positive
:
=
match
p
with
|
1
=>
1
~
0
|
p
~
0
=>
(
prod_encode_snd
p
)~
0
~
0
|
p
~
1
=>
(
prod_encode_snd
p
)~
1
~
0
end
.
Fixpoint
prod_encode
(
p
q
:
positive
)
:
positive
:
=
match
p
,
q
with
|
1
,
1
=>
1
~
1
|
p
~
0
,
1
=>
(
prod_encode_fst
p
)~
1
~
0
|
p
~
1
,
1
=>
(
prod_encode_fst
p
)~
1
~
1
|
1
,
q
~
0
=>
(
prod_encode_snd
q
)~
0
~
1
|
1
,
q
~
1
=>
(
prod_encode_snd
q
)~
1
~
1
|
p
~
0
,
q
~
0
=>
(
prod_encode
p
q
)~
0
~
0
|
p
~
0
,
q
~
1
=>
(
prod_encode
p
q
)~
1
~
0
|
p
~
1
,
q
~
0
=>
(
prod_encode
p
q
)~
0
~
1
|
p
~
1
,
q
~
1
=>
(
prod_encode
p
q
)~
1
~
1
end
.
Fixpoint
prod_decode_fst
(
p
:
positive
)
:
option
positive
:
=
match
p
with
|
p
~
0
~
0
=>
(~
0
)
<$>
prod_decode_fst
p
|
p
~
0
~
1
=>
Some
match
prod_decode_fst
p
with
Some
q
=>
q
~
1
|
_
=>
1
end
|
p
~
1
~
0
=>
(~
0
)
<$>
prod_decode_fst
p
|
p
~
1
~
1
=>
Some
match
prod_decode_fst
p
with
Some
q
=>
q
~
1
|
_
=>
1
end
|
1
~
0
=>
None
|
1
~
1
=>
Some
1
|
1
=>
Some
1
end
.
Fixpoint
prod_decode_snd
(
p
:
positive
)
:
option
positive
:
=
match
p
with
|
p
~
0
~
0
=>
(~
0
)
<$>
prod_decode_snd
p
|
p
~
0
~
1
=>
(~
0
)
<$>
prod_decode_snd
p
|
p
~
1
~
0
=>
Some
match
prod_decode_snd
p
with
Some
q
=>
q
~
1
|
_
=>
1
end
|
p
~
1
~
1
=>
Some
match
prod_decode_snd
p
with
Some
q
=>
q
~
1
|
_
=>
1
end
|
1
~
0
=>
Some
1
|
1
~
1
=>
Some
1
|
1
=>
None
end
.
Lemma
prod_decode_encode_fst
p
q
:
prod_decode_fst
(
prod_encode
p
q
)
=
Some
p
.
Proof
.
assert
(
∀
p
,
prod_decode_fst
(
prod_encode_fst
p
)
=
Some
p
).
{
intros
p'
.
by
induction
p'
;
simplify_option_equality
.
}
assert
(
∀
p
,
prod_decode_fst
(
prod_encode_snd
p
)
=
None
).
{
intros
p'
.
by
induction
p'
;
simplify_option_equality
.
}
revert
q
.
by
induction
p
;
intros
[?|?|]
;
simplify_option_equality
.
Qed
.
Lemma
prod_decode_encode_snd
p
q
:
prod_decode_snd
(
prod_encode
p
q
)
=
Some
q
.
Proof
.
assert
(
∀
p
,
prod_decode_snd
(
prod_encode_snd
p
)
=
Some
p
).
{
intros
p'
.
by
induction
p'
;
simplify_option_equality
.
}
assert
(
∀
p
,
prod_decode_snd
(
prod_encode_fst
p
)
=
None
).
{
intros
p'
.
by
induction
p'
;
simplify_option_equality
.
}
revert
q
.
by
induction
p
;
intros
[?|?|]
;
simplify_option_equality
.
Qed
.
Program
Instance
prod_countable
`
{
Countable
A
}
`
{
Countable
B
}
:
Countable
(
A
*
B
)%
type
:
=
{|
encode
xy
:
=
let
(
x
,
y
)
:
=
xy
in
prod_encode
(
encode
x
)
(
encode
y
)
;
decode
p
:
=
x
←
prod_decode_fst
p
≫
=
decode
;
y
←
prod_decode_snd
p
≫
=
decode
;
Some
(
x
,
y
)
|}.
Next
Obligation
.
intros
??????
[
x
y
]
;
simpl
.
rewrite
prod_decode_encode_fst
,
prod_decode_encode_snd
.
simpl
.
by
rewrite
!
decode_encode
.
Qed
.
Fixpoint
list_encode_
(
l
:
list
positive
)
:
positive
:
=
match
l
with
[]
=>
1
|
x
::
l
=>
prod_encode
x
(
list_encode_
l
)
end
.
Definition
list_encode
(
l
:
list
positive
)
:
positive
:
=
prod_encode
(
Pos
.
of_nat
(
S
(
length
l
)))
(
list_encode_
l
).
Fixpoint
list_decode_
(
n
:
nat
)
(
p
:
positive
)
:
option
(
list
positive
)
:
=
match
n
with
|
O
=>
guard
(
p
=
1
)
;
Some
[]
|
S
n
=>
x
←
prod_decode_fst
p
;
pl
←
prod_decode_snd
p
;
l
←
list_decode_
n
pl
;
Some
(
x
::
l
)
end
.
Definition
list_decode
(
p
:
positive
)
:
option
(
list
positive
)
:
=
pn
←
prod_decode_fst
p
;
pl
←
prod_decode_snd
p
;
list_decode_
(
pred
(
Pos
.
to_nat
pn
))
pl
.
Lemma
list_decode_encode
l
:
list_decode
(
list_encode
l
)
=
Some
l
.
Proof
.
cut
(
list_decode_
(
length
l
)
(
list_encode_
l
)
=
Some
l
).
{
intros
help
.
unfold
list_decode
,
list_encode
.
rewrite
prod_decode_encode_fst
,
prod_decode_encode_snd
;
simpl
.
by
rewrite
Nat2Pos
.
id
by
done
;
simpl
.
}
induction
l
;
simpl
;
auto
.
by
rewrite
prod_decode_encode_fst
,
prod_decode_encode_snd
;
simplify_option_equality
.
Qed
.
Program
Instance
list_countable
`
{
Countable
A
}
:
Countable
(
list
A
)
:
=
{|
encode
l
:
=
list_encode
(
encode
<$>
l
)
;
decode
p
:
=
list_decode
p
≫
=
mapM
decode
|}.
Next
Obligation
.
intros
???
l
.
rewrite
list_decode_encode
.
simpl
.
apply
mapM_fmap_Some
;
auto
using
decode_encode
.
Qed
.
Program
Instance
pos_countable
:
Countable
positive
:
=
{|
encode
:
=
id
;
decode
:
=
Some
;
decode_encode
x
:
=
eq_refl
|}.
Program
Instance
N_countable
:
Countable
N
:
=
{|
encode
x
:
=
match
x
with
N0
=>
1
|
Npos
p
=>
Pos
.
succ
p
end
;
decode
p
:
=
if
decide
(
p
=
1
)
then
Some
0
%
N
else
Some
(
Npos
(
Pos
.
pred
p
))
|}.
Next
Obligation
.
intros
[|
p
]
;
simpl
;
repeat
case_decide
;
auto
with
lia
.
by
rewrite
Pos
.
pred_succ
.
Qed
.
Program
Instance
Z_countable
:
Countable
Z
:
=
{|
encode
x
:
=
match
x
with
Z0
=>
1
|
Zpos
p
=>
p
~
0
|
Zneg
p
=>
p
~
1
end
;
decode
p
:
=
Some
match
p
with
1
=>
Z0
|
p
~
0
=>
Zpos
p
|
p
~
1
=>
Zneg
p
end
|}.
Next
Obligation
.
by
intros
[|
p
|
p
].
Qed
.
Program
Instance
nat_countable
:
Countable
nat
:
=
{|
encode
x
:
=
encode
(
N
.
of_nat
x
)
;
decode
p
:
=
N
.
to_nat
<$>
decode
p
|}.
Next
Obligation
.
intros
x
.
rewrite
decode_encode
;
simpl
.
by
rewrite
Nat2N
.
id
.
Qed
.
theories/finite.v
0 → 100644
View file @
b0f5f6e6
Require
Export
countable
list
.
Obligation
Tactic
:
=
idtac
.
Class
Finite
A
`
{
∀
x
y
:
A
,
Decision
(
x
=
y
)}
:
=
{
enum
:
list
A
;
enum_nodup
:
NoDup
enum
;
elem_of_enum
x
:
x
∈
enum
}.
Arguments
enum
_
{
_
_
}
:
clear
implicits
.
Arguments
enum_nodup
_
{
_
_
}
:
clear
implicits
.
Definition
card
A
`
{
Finite
A
}
:
=
length
(
enum
A
).
Program
Instance
finite_countable
`
{
Finite
A
}
:
Countable
A
:
=
{|
encode
:
=
λ
x
,
Pos
.
of_nat
$
S
$
from_option
0
$
list_find
(
x
=)
(
enum
A
)
;
decode
:
=
λ
p
,
enum
A
!!
pred
(
Pos
.
to_nat
p
)
|}.
Arguments
Pos
.
of_nat
_
:
simpl
never
.
Next
Obligation
.
intros
??
[
xs
Hxs
HA
]
x
;
unfold
encode
,
decode
;
simpl
.
destruct
(
list_find_eq_elem_of
xs
x
)
as
[
i
Hi
]
;
auto
.
rewrite
Nat2Pos
.
id
by
done
;
simpl
.
rewrite
Hi
;
eauto
using
list_find_eq_Some
.
Qed
.
Definition
find
`
{
Finite
A
}
P
`
{
∀
x
,
Decision
(
P
x
)}
:
option
A
:
=
list_find
P
(
enum
A
)
≫
=
decode_nat
.
Lemma
encode_lt_card
`
{
finA
:
Finite
A
}
x
:
encode_nat
x
<
card
A
.
Proof
.
destruct
finA
as
[
xs
Hxs
HA
]
;
unfold
encode_nat
,
encode
,
card
;
simpl
.
rewrite
Nat2Pos
.
id
by
done
;
simpl
.
destruct
(
list_find
_
xs
)
eqn
:
?
;
simpl
.
*
eapply
lookup_lt_Some
,
list_find_eq_Some
;
eauto
.
*
destruct
xs
;
simpl
.
exfalso
;
eapply
not_elem_of_nil
,
(
HA
x
).
lia
.
Qed
.
Lemma
encode_decode
A
`
{
finA
:
Finite
A
}
i
:
i
<
card
A
→
∃
x
,
decode_nat
i
=
Some
x
∧
encode_nat
x
=
i
.
Proof
.
destruct
finA
as
[
xs
Hxs
HA
].
unfold
encode_nat
,
decode_nat
,
encode
,
decode
,
card
;
simpl
.
intros
Hi
.
apply
lookup_lt_is_Some
in
Hi
.
destruct
Hi
as
[
x
Hx
].
exists
x
.
rewrite
!
Nat2Pos
.
id
by
done
;
simpl
.
destruct
(
list_find_eq_elem_of
xs
x
)
as
[
j
Hj
]
;
auto
.
rewrite
Hj
.
eauto
using
list_find_eq_Some
,
NoDup_lookup
.
Qed
.
Lemma
find_Some
`
{
finA
:
Finite
A
}
P
`
{
∀
x
,
Decision
(
P
x
)}
x
:
find
P
=
Some
x
→
P
x
.
Proof
.
destruct
finA
as
[
xs
Hxs
HA
]
;
unfold
find
,
decode_nat
,
decode
;
simpl
.
intros
Hx
.
destruct
(
list_find
_
_
)
as
[
i
|]
eqn
:
Hi
;
simplify_option_equality
.
rewrite
!
Nat2Pos
.
id
in
Hx
by
done
.
destruct
(
list_find_Some
P
xs
i
)
as
(?&?&?)
;
simplify_option_equality
;
eauto
.
Qed
.
Lemma
find_is_Some
`
{
finA
:
Finite
A
}
P
`
{
∀
x
,
Decision
(
P
x
)}
x
:
P
x
→
∃
y
,
find
P
=
Some
y
∧
P
y
.
Proof
.
destruct
finA
as
[
xs
Hxs
HA
]
;
unfold
find
,
decode
;
simpl
.
intros
Hx
.
destruct
(
list_find_elem_of
P
xs
x
)
as
[
i
Hi
]
;
auto
.
rewrite
Hi
.
destruct
(
list_find_Some
P
xs
i
)
as
(
y
&?&?)
;
subst
;
auto
.
exists
y
.
simpl
.
by
rewrite
!
Nat2Pos
.
id
by
done
.
Qed
.
Lemma
card_0_inv
P
`
{
finA
:
Finite
A
}
:
card
A
=
0
→
A
→
P
.
Proof
.
intros
?
x
.
destruct
finA
as
[[|??]
??]
;
simplify_equality
.
by
destruct
(
not_elem_of_nil
x
).
Qed
.
Lemma
finite_inhabited
A
`
{
finA
:
Finite
A
}
:
0
<
card
A
→
Inhabited
A
.
Proof
.
unfold
card
.
destruct
finA
as
[[|
x
?]
??]
;
simpl
;
auto
with
lia
.
constructor
;
exact
x
.
Qed
.
Lemma
finite_injective_contains
`
{
finA
:
Finite
A
}
`
{
finB
:
Finite
B
}
(
f
:
A
→
B
)
`
{!
Injective
(=)
(=)
f
}
:
f
<$>
enum
A
`
contains
`
enum
B
.
Proof
.
intros
.
destruct
finA
,
finB
.
apply
NoDup_contains
;
auto
using
fmap_nodup_2
.
Qed
.
Lemma
finite_injective_Permutation
`
{
Finite
A
}
`
{
Finite
B
}
(
f
:
A
→
B
)
`
{!
Injective
(=)
(=)
f
}
:
card
A
=
card
B
→
f
<$>
enum
A
≡
ₚ
enum
B
.
Proof
.
intros
.
apply
contains_Permutation
.
*
by
rewrite
fmap_length
.
*
by
apply
finite_injective_contains
.
Qed
.
Lemma
finite_injective_surjective
`
{
Finite
A
}
`
{
Finite
B
}
(
f
:
A
→
B
)
`
{!
Injective
(=)
(=)
f
}
:
card
A
=
card
B
→
Surjective
(=)
f
.
Proof
.
intros
HAB
y
.
destruct
(
elem_of_list_fmap_2
f
(
enum
A
)
y
)
as
(
x
&?&?)
;
eauto
.
rewrite
finite_injective_Permutation
;
auto
using
elem_of_enum
.
Qed
.
Lemma
finite_surjective
A
`
{
Finite
A
}
B
`
{
Finite
B
}
:
0
<
card
A
≤
card
B
→
∃
g
:
B
→
A
,
Surjective
(=)
g
.
Proof
.
intros
[??].
destruct
(
finite_inhabited
A
)
as
[
x'
]
;
auto
with
lia
.
exists
(
λ
y
:
B
,
from_option
x'
(
decode_nat
(
encode_nat
y
))).
intros
x
.
destruct
(
encode_decode
B
(
encode_nat
x
))
as
(
y
&
Hy1
&
Hy2
).
{
pose
proof
(
encode_lt_card
x
)
;
lia
.
}
exists
y
.
by
rewrite
Hy2
,
decode_encode_nat
.
Qed
.
Lemma
finite_injective
A
`
{
Finite
A
}
B
`
{
Finite
B
}
:
card
A
≤
card
B
↔
∃
f
:
A
→
B
,
Injective
(=)
(=)
f
.
Proof
.
split
.
*
intros
.
destruct
(
decide
(
card
A
=
0
))
as
[
HA
|?].
{
exists
(
card_0_inv
B
HA
).
intros
y
.
apply
(
card_0_inv
_
HA
y
).
}
destruct
(
finite_surjective
A
B
)
as
(
g
&?)
;
auto
with
lia
.
destruct
(
surjective_cancel
g
)
as
(
f
&?).
exists
f
.
apply
cancel_injective
.
*
intros
[
f
?].
unfold
card
.
rewrite
<-(
fmap_length
f
).
by
apply
contains_length
,
(
finite_injective_contains
f
).
Qed
.
Lemma
finite_bijective
A
`
{
Finite
A
}
B
`
{
Finite
B
}
:
card
A
=
card
B
↔
∃
f
:
A
→
B
,
Injective
(=)
(=)
f
∧
Surjective
(=)
f
.
Proof
.
split
.
*
intros
;
destruct
(
proj1
(
finite_injective
A
B
))
as
[
f
?]
;
auto
with
lia
.
exists
f
;
auto
using
(
finite_injective_surjective
f
).
*
intros
(
f
&?&?).
apply
(
anti_symmetric
(
≤
))
;
apply
finite_injective
.
+
by
exists
f
.
+
destruct
(
surjective_cancel
f
)
as
(
g
&?)
;
eauto
using
cancel_injective
.
Qed
.
Lemma
injective_card
`
{
Finite
A
}
`
{
Finite
B
}
(
f
:
A
→
B
)
`
{!
Injective
(=)
(=)
f
}
:
card
A
≤
card
B
.
Proof
.
apply
finite_injective
.
eauto
.
Qed
.
Lemma
surjective_card
`
{
Finite
A
}
`
{
Finite
B
}
(
f
:
A
→
B
)
`
{!
Surjective
(=)
f
}
:
card
B
≤
card
A
.
Proof
.
destruct
(
surjective_cancel
f
)
as
(
g
&?).
apply
injective_card
with
g
,
cancel_injective
.
Qed
.
Lemma
bijective_card
`
{
Finite
A
}
`
{
Finite
B
}
(
f
:
A
→
B
)
`
{!
Injective
(=)
(=)
f
}
`
{!
Surjective
(=)
f
}
:
card
A
=
card
B
.
Proof
.
apply
finite_bijective
.
eauto
.
Qed
.
(** Instances *)
Section
enc_finite
.
Context
`
{
∀
x
y
:
A
,
Decision
(
x
=
y
)}.
Context
(
to_nat
:
A
→
nat
)
(
of_nat
:
nat
→
A
)
(
c
:
nat
).
Context
(
of_to_nat
:
∀
x
,
of_nat
(
to_nat
x
)
=
x
).
Context
(
to_nat_c
:
∀
x
,
to_nat
x
<
c
).
Context
(
to_of_nat
:
∀
i
,
i
<
c
→
to_nat
(
of_nat
i
)
=
i
).
Program
Instance
enc_finite
:
Finite
A
:
=
{|
enum
:
=
of_nat
<$>
seq
0
c
|}.
Next
Obligation
.
apply
NoDup_alt
.
intros
i
j
x
.
rewrite
!
list_lookup_fmap
.
intros
Hi
Hj
.
destruct
(
seq
_
_
!!
i
)
as
[
i'
|]
eqn
:
Hi'
,
(
seq
_
_
!!
j
)
as
[
j'
|]
eqn
:
Hj'
;
simplify_equality
.
destruct
(
lookup_seq_inv
_
_
_
_
Hi'
),
(
lookup_seq_inv
_
_
_
_
Hj'
)
;
subst
.
rewrite
<-(
to_of_nat
i
),
<-(
to_of_nat
j
)
by
done
.
by
f_equal
.
Qed
.
Next
Obligation
.
intros
x
.
rewrite
elem_of_list_fmap
.
exists
(
to_nat
x
).
split
;
auto
.
by
apply
elem_of_list_lookup_2
with
(
to_nat
x
),
lookup_seq
.
Qed
.
Lemma
enc_finite_card
:
card
A
=
c
.
Proof
.
unfold
card
.
simpl
.
by
rewrite
fmap_length
,
seq_length
.
Qed
.
End
enc_finite
.
Section
bijective_finite
.
Context
`
{
Finite
A
}
`
{
∀
x
y
:
B
,
Decision
(
x
=
y
)}
(
f
:
A
→
B
)
(
g
:
B
→
A
).
Context
`
{!
Injective
(=)
(=)
f
}
`
{!
Cancel
(=)
f
g
}.
Program
Instance
bijective_finite
:
Finite
B
:
=
{|
enum
:
=
f
<$>
enum
A
|}.
Next
Obligation
.
apply
(
fmap_nodup
_
),
enum_nodup
.
Qed
.
Next
Obligation
.
intros
y
.
rewrite
elem_of_list_fmap
.
eauto
using
elem_of_enum
.
Qed
.
End
bijective_finite
.
Program
Instance
option_finite
`
{
Finite
A
}
:
Finite
(
option
A
)
:
=
{|
enum
:
=
None
::
Some
<$>
enum
A
|}.
Next
Obligation
.
constructor
.
*
rewrite
elem_of_list_fmap
.
by
intros
(?&?&?).
*
apply
(
fmap_nodup
_
)
;
auto
using
enum_nodup
.
Qed
.
Next
Obligation
.
intros
???
[
x
|]
;
[
right
|
left
]
;
auto
.
apply
elem_of_list_fmap
.
eauto
using
elem_of_enum
.
Qed
.
Lemma
option_cardinality
`
{
Finite
A
}
:
card
(
option
A
)
=
S
(
card
A
).
Proof
.
unfold
card
.
simpl
.
by
rewrite
fmap_length
.
Qed
.
Program
Instance
unit_finite
:
Finite
()
:
=
{|
enum
:
=
[
tt
]
|}.
Next
Obligation
.
apply
NoDup_singleton
.
Qed
.
Next
Obligation
.
intros
[].
by
apply
elem_of_list_singleton
.
Qed
.
Lemma
unit_card
:
card
unit
=
1
.
Proof
.
done
.
Qed
.
Program
Instance
bool_finite
:
Finite
bool
:
=
{|
enum
:
=
[
true
;
false
]
|}.
Next
Obligation
.
constructor
.
by
rewrite
elem_of_list_singleton
.
apply
NoDup_singleton
.
Qed
.
Next
Obligation
.
intros
[|].
left
.
right
;
left
.
Qed
.
Lemma
bool_card
:
card
bool
=
2
.
Proof
.
done
.
Qed
.
Program
Instance
sum_finite
`
{
Finite
A
}
`
{
Finite
B
}
:
Finite
(
A
+
B
)%
type
:
=
{|
enum
:
=
(
inl
<$>
enum
A
)
++
(
inr
<$>
enum
B
)
|}.
Next
Obligation
.
intros
.
apply
NoDup_app
;
split_ands
.
*
apply
(
fmap_nodup
_
).
by
apply
enum_nodup
.
*
intro
.
rewrite
!
elem_of_list_fmap
.
intros
(?&?&?)
(?&?&?)
;
congruence
.
*
apply
(
fmap_nodup
_
).
by
apply
enum_nodup
.
Qed
.
Next
Obligation
.
intros
??????
[
x
|
y
]
;
rewrite
elem_of_app
,
!
elem_of_list_fmap
;
eauto
using
@
elem_of_enum
.
Qed
.
Lemma
sum_card
`
{
Finite
A
}
`
{
Finite
B
}
:
card
(
A
+
B
)
=
card
A
+
card
B
.
Proof
.
unfold
card
.
simpl
.
by
rewrite
app_length
,
!
fmap_length
.
Qed
.
Program
Instance
prod_finite
`
{
Finite
A
}
`
{
Finite
B
}
:
Finite
(
A
*
B
)%
type
:
=
{|
enum
:
=
foldr
(
λ
x
,
(
pair
x
<$>
enum
B
++))
[]
(
enum
A
)
|}.
Next
Obligation
.
intros
??????.
induction
(
enum_nodup
A
)
as
[|
x
xs
Hx
Hxs
IH
]
;
simpl
.
{
constructor
.
}
apply
NoDup_app
;
split_ands
.
*
apply
(
fmap_nodup
_
).
by
apply
enum_nodup
.
*
intros
[?
y
].
rewrite
elem_of_list_fmap
.
intros
(?&?&?)
;
simplify_equality
.
clear
IH
.
induction
Hxs
as
[|
x'
xs
??
IH
]
;
simpl
.
{
rewrite
elem_of_nil
.
tauto
.
}
rewrite
elem_of_app
,
elem_of_list_fmap
.
intros
[(?&?&?)|?]
;
simplify_equality
.
+
destruct
Hx
.
by
left
.
+
destruct
IH
.
by
intro
;
destruct
Hx
;
right
.
auto
.
*
done
.
Qed
.
Next
Obligation
.
intros
??????
[
x
y
].
induction
(
elem_of_enum
x
)
;
simpl
.
*
rewrite
elem_of_app
,
!
elem_of_list_fmap
.
eauto
using
@
elem_of_enum
.
*
rewrite
elem_of_app
;
eauto
.
Qed
.
Lemma
prod_card
`
{
Finite
A
}
`
{
Finite
B
}
:
card
(
A
*
B
)
=
card
A
*
card
B
.
Proof
.
unfold
card
;
simpl
.
induction
(
enum
A
)
;
simpl
;
auto
.
rewrite
app_length
,
fmap_length
.
auto
.
Qed
.
Let
list_enum
{
A
}
(
l
:
list
A
)
:
∀
n
,
list
{
l
:
list
A
|
length
l
=
n
}
:
=
fix
go
n
:
=
match
n
with
|
0
=>
[[]
↾
eq_refl
]
|
S
n
=>
foldr
(
λ
x
,
(
sig_map
(
x
::
)
(
λ
_
H
,
f_equal
S
H
)
<$>
(
go
n
)
++))
[]
l
end
.
Program
Instance
list_finite
`
{
Finite
A
}
n
:
Finite
{
l
|
length
l
=
n
}
:
=
{|
enum
:
=
list_enum
(
enum
A
)
n
|}.
Next
Obligation
.
intros
????.
induction
n
as
[|
n
IH
]
;
simpl
;
[
apply
NoDup_singleton
|].
revert
IH
.
generalize
(
list_enum
(
enum
A
)
n
).
intros
l
Hl
.
induction
(
enum_nodup
A
)
as
[|
x
xs
Hx
Hxs
IH
]
;
simpl
;
auto
;
[
constructor
|].
apply
NoDup_app
;
split_ands
.
*
by
apply
(
fmap_nodup
_
).
*
intros
[
k1
Hk1
].
clear
Hxs
IH
.
rewrite
elem_of_list_fmap
.
intros
([
k2
Hk2
]&?&?)
Hxk2
;
simplify_equality
.
destruct
Hx
.
revert
Hxk2
.
induction
xs
as
[|
x'
xs
IH
]
;
simpl
in
*
;
[
by
rewrite
elem_of_nil
|].
rewrite
elem_of_app
,
elem_of_list_fmap
,
elem_of_cons
.
intros
[([??]&?&?)|?]
;
simplify_equality
;
auto
.
*
apply
IH
.
Qed
.
Next
Obligation
.
intros
????
[
l
Hl
].
revert
l
Hl
.
induction
n
as
[|
n
IH
]
;
intros
[|
x
l
]
?
;
simpl
;
simplify_equality
.
{
apply
elem_of_list_singleton
.
by
apply
(
sig_eq_pi
_
).
}
revert
IH
.
generalize
(
list_enum
(
enum
A
)
n
).
intros
k
Hk
.
induction
(
elem_of_enum
x
)
as
[
x
xs
|
x
xs
]
;
simpl
in
*.
*
rewrite
elem_of_app
,
elem_of_list_fmap
.
left
.
injection
Hl
.
intros
Hl'
.
eexists
(
l
↾
Hl'
).
split
.
by
apply
(
sig_eq_pi
_
).
done
.
*
rewrite
elem_of_app
.
eauto
.
Qed
.
Lemma
list_card
`
{
Finite
A
}
n
:
card
{
l
|
length
l
=
n
}
=
card
A
^
n
.
Proof
.
unfold
card
;
simpl
.
induction
n
as
[|
n
IH
]
;
simpl
;
auto
.
rewrite
<-
IH
.
clear
IH
.
generalize
(
list_enum
(
enum
A
)
n
).
induction
(
enum
A
)
as
[|
x
xs
IH
]
;
intros
l
;
simpl
;
auto
.
by
rewrite
app_length
,
fmap_length
,
IH
.
Qed
.
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment