--> ****************************************************************
-->    Proof Scores on Generic Set with Intersection Operation
--> ****************************************************************

--> ----------------------------------------------------------------
--> SET: generic sets 
--> ----------------------------------------------------------------
mod! SET(X :: TRIV) {
[Elt < Set]
-- empty set
op empty : -> Set {constr} .
-- assicative and commutative set constructor with identity 'empty'
op __ : Set Set -> Set {constr assoc comm id: empty} .
-- impotency
ceq (S:Set S) = S if not(S == empty) .
}

--> ----------------------------------------------------------------
--> TRIV=: TRIV with equality expressed with _=e_
--> ----------------------------------------------------------------
mod* TRIV= {
[Elt]
-- equality on Elt
pred _=e_ : Elt Elt {comm} .
eq (E:Elt =e E) = true .
cq [:nonexec]: E1:Elt = E2:Elt if (E1 =e E2) .
}
--> ----------------------------------------------------------------
--> SETin: generic sets with _in_
--> ----------------------------------------------------------------
mod! SETin (X :: TRIV=) {
pr(SET(X))
-- in
pred _in_ : Elt Set .
eq (E:Elt in empty) = false .
eq (E1:Elt in (E2:Elt S:Set)) = ((E1 =e E2) or (E1 in S)) .
}

--> ----------------------------------------------------------------
-- set intersection: SET^ 
--> ----------------------------------------------------------------
mod! SET^ (X :: TRIV=) {
pr(SETin(X))
-- intersection of two sets
op _^_ : Set Set -> Set .
eq empty ^ S2:Set = empty .
eq (E:Elt S1:Set) ^ S2:Set =
   if E in S2 then E (S1 ^ S2) else (S1 ^ S2) fi .
}

--> ================================================================
--> basic tests for SET^
--> ----------------------------------------------------------------
open SET^(NAT{op E1:Elt =e E2:Elt -> E1:Nat == E2:Nat}) .
red 1 ^ 2 3 .
-- red 1 2 ^ 2 3 .  -- error, ambiguous expression
red (1 2) ^ 2 3 .
red (1 2) ^ (2 3 1) .
close

--> ================================================================
--> proof score for the property:
--> eq[in^]: E:Elt in (S1:Set ^ S2:Set) = E in S1 and E in S2 .
--> with CITP
--> ----------------------------------------------------------------
-- proof: by induction on the number of elements in S1:Set
--> induction base
open SET^ .
-- check the base
op e : -> Elt .
op s2 : -> Set .
red (e in (empty ^ s2)) = (e in empty and e in s2) .
close
--> induction step
mod SET^in-iStep {
pr(SET^)
-- induction hypothesis
op s1 : -> Set .
eq (E:Elt in (s1 ^ S2:Set)) = (E in s1 and E in S2) .
-- fresh constants
ops e e1 : -> Elt .
op s2 : -> Set .
-- induction step proposition
op iStep : -> Bool .
eq iStep = ((e in ((e1 s1) ^ s2)) = ((e in (e1 s1)) and (e in s2))) .
}
-- check the step
select SET^in-iStep .
:goal{eq iStep = true .}
:def csp-1 = :csp{eq e = e1 . eq (e =e e1) = false .} 
:def ctf-2 = :ctf[e1 in s2 .]
:apply(csp-1 rd- ctf-2 rd-)
--> QED
--> ----------------------------------------------------------------
-- another check the step
select SET^in-iStep .
:goal{eq iStep = true .}
:def csp-1 = :csp{eq e = e1 . eq (e =e e1) = false .}
:def csp-1-r = (csp-1 rd-)
:def ctf-2 = :ctf[e1 in s2 .]
:def ctf-2-r = (ctf-2 rd-)
:apply(csp-1-r ctf-2-r)

-- yet another check the step
open SET^in-iStep .
eq e = e1 .
eq (e1 in s2) = true .
red iStep .
close
--
open SET^in-iStep .
eq e = e1 .
eq (e1 in s2) = false .
red iStep .
close
--
open SET^in-iStep .
eq (e =e e1) = false .
eq (e1 in s2) = true .
red iStep .
close
--
open SET^in-iStep .
eq (e =e e1) = false .
eq (e1 in s2) = false .
red iStep .
close
--> ================================================================

--> ================================================================
--> proof score for associativity of _^_: 
--> eq[^assoc]: S1:Set ^ (S2:Set ^ S3:Set) =
-->            (S1:Set ^ S2:Set) ^ S3:Set .
--> ----------------------------------------------------------------
-- proof: by induction on the number of elements in S:Set
--> induction base
open SET^ .
-- check the base
ops s2 s3 : -> Set .
red empty ^ (s2 ^ s3) = (empty ^ s2) ^ s3 .
close
--> induction step
mod SET^assoc-iStep {
pr(SET^)
-- induction hypothesis
op s1 : -> Set .
eq s1 ^ (S2:Set ^ S3:Set) = (s1 ^ S2) ^ S3 .
-- already proved property
eq E:Elt in (S1:Set ^ S2:Set) = (E in S1) and (E in S2) .
-- fresh constants
op e : -> Elt .
ops s2 s3 : -> Set .
-- induction step proposition
op iStep : -> Bool .
eq iStep = ((e s1) ^ (s2 ^ s3) = ((e s1) ^ s2) ^ s3) .
}
select SET^assoc-iStep .
:goal{eq iStep = true .}
:def ctf-1 = :ctf[e in s2 .]
:def ctf-2 = :ctf[e in s3 .]
:apply(ctf-1 rd- ctf-2 rd-)
--> QED
--> ----------------------------------------------------------------
-- inspecting proof
show proof
desc proof
--> ================================================================

--> ================================================================
--> proof score for the property:
--> eq[^em]: S1:Set ^ empty = empty .
--> ----------------------------------------------------------------
-- proof: by induction on the number of elements in S1:Set
--> induction base
select SET^ .
red empty ^ empty = empty .
--> induction step
open SET^ .
-- induction hypothesis
op s1 : -> Set .
eq s1 ^ empty = empty .
-- check the step
op e : -> Elt .
red (e s1) ^ empty = empty .
close
--> QED
--> ================================================================

--> ================================================================
--> proof score for the property:
--> eq[^res]: S1:Set ^ (E:Elt S2:Set) =
-->           if E in S1 then E (S1 ^ S2) else (S1 ^ S2) fi .
--> ----------------------------------------------------------------
-- proof: induction on the number of elements in S1:Set
--> induction base
open SET^ .
op e : -> Elt .
op s2 : -> Set .
red empty ^ (e s2) =
     if e in empty then e (empty ^ s2) else (empty ^ s2) fi .
close
--> induction step
mod SET^res-iStep {
pr(SET^)
-- induction hypothesis
op s1 : -> Set .
eq s1 ^ (E:Elt S2:Set) = if E in s1 then E (s1 ^ S2) else (s1 ^ S2) fi .
-- fresh constants
ops e e1 : -> Elt . op s2 : -> Set .
-- induction step proposition
op iStep : -> Bool .
eq iStep = ((e s1) ^ (e1 s2) =
            if e1 in (e s1) then e1 ((e s1) ^ s2)
	                     else ((e s1) ^ s2) fi) .
}
-- check the induction step proposition
select SET^res-iStep .
:goal{eq iStep = true .}
:def csp-1 = :csp{eq e = e1 . eq (e =e e1) = false .} 
:def ctf-2 = :ctf[e1 in s1 .]
:def ctf-3 = :ctf[e1 in s2 .]
:def ctf-4 = :ctf[e in s1 .]
:def ctf-5 = :ctf[e in s2 .]
-- either of the following three :apply(...) works
-- :apply (csp-1 rd- ctf-2 rd- ctf-3 rd- ctf-4 rd- ctf-5 rd-)
-- :apply (csp-1 rd- ctf-2 rd- ctf-3 rd- ctf-5 rd-)
:apply (csp-1 rd-) :apply(ctf-2 rd- ctf-3 rd-) :apply(ctf-2 rd- ctf-5 rd-)
** successful
--> QED
--> ----------------------------------------------------------------
-- :show proof
-- :describe proof
--> ================================================================

--> ================================================================
--> proof score for commutativity of _^_:
--> eq[^comm]: S1:Set ^ S2:Set = S2 ^ S1 .
--> ----------------------------------------------------------------
-- proof: by induction on the number of elements in S1:Set
--> induction base
open SET^ .
-- already proved property
eq[^em]: S1:Set ^ empty = empty .
-- check
op s2 : -> Set .
red empty ^ s2 = s2 ^ empty .
close
--> induction step
mod SET^comm-iStep {pr(SET^)
-- induction hypothesis
op s1 : -> Set .
eq s1 ^ S2:Set = S2 ^ s1 .
-- already proved property
eq[^res]: S1:Set ^ (E:Elt S2:Set) =
          if E in S1 then E (S1 ^ S2) else (S1 ^ S2) fi .
-- fresh constants
op e : -> Elt .
op s2 : -> Set .
-- induction step proposition
op iStep : -> Bool .
eq iStep = ((e s1) ^ s2 = s2 ^ (e s1)) .
}
--> check the step
select SET^comm-iStep .
:goal{eq iStep = true .}
:def ctf-1 = :ctf[e in s2 .]
:apply (ctf-1 rd-)
--> QED
--> ----------------------------------------------------------------

-- another proof score
--> case: eq e in s2 = true .
open SET^comm-iStep .
-- case splitting eq
eq e in s2 = true .
-- check
red iStep .
close
--> case: eq e in s2 = false .
open SET^comm-iStep .
-- case splitting eq
eq e in s2 = false .
-- check
red iStep .
close
--> QED
--> ================================================================

--> ****************************************************************
--> end of file
eof
--> ****************************************************************