--> ****************************************************************
--> proof scores for associativity and commutativity of
--> _+_ and _*_ over Nat.PNAT with SpecCalc/CITP
--> ****************************************************************

--> -----------------------------------------------------------------
--> PNAT: Peano NATural numbers
--> -----------------------------------------------------------------
mod! PNAT {
[Nat]
op 0 : -> Nat {constr} .
op s_ : Nat -> Nat {constr} .
}

--> ----------------------------------------------------------------
--> PNAT with the addition _+_
--> ----------------------------------------------------------------
mod! PNAT+ {
pr(PNAT)
op _+_ : Nat Nat -> Nat .
eq 0 + Y:Nat = Y .
eq s X:Nat + Y:Nat = s(X + Y) .
}

--> ================================================================
--> proof score for proving right 0 of _+_:
-->   eq[+r0]: X:Nat + 0 = X .
--> with the induction on X:Nat
--> ----------------------------------------------------------------
--> proof with CITP
select PNAT+ .
:goal{eq[+r0]: X:Nat + 0 = X .}
-- by induction on X
:ind on (X:Nat) .
-- check
:apply (SI TC RD) .
--> QED
-- :describe proof
--> ================================================================

--> ================================================================
--> proof score for proving right s_ of _+_:
-->   eq[+rs]: X:Nat + s Y:Nat = s (X + Y) .
--> with the induction on X:Nat
--> ----------------------------------------------------------------
-- proof with CITP
select PNAT+ .
:goal{eq[+rs]: X:Nat + (s Y:Nat) = s (X + Y) .}
-- by induction on X
:ind on (X:Nat) .
-- check
:apply (SI TC RD) .
--> QED
-- :describe proof
--> ================================================================

--> ================================================================
--> proof score for proving commutativity of _+_:
-->   eq (X:Nat + Y:Nat) = (Y + X) .
--> with the induction on X:Nat
--> ----------------------------------------------------------------
-- proof with CITP
mod PNAT+comm
{
pr(PNAT+)
-- proved properties
eq[+r0]:  X:Nat + 0 = X .
eq[+rs]: X:Nat + (s Y:Nat) = s (X + Y) .
}
select PNAT+comm .
:goal{eq[+comm]: X:Nat + Y:Nat = Y + X .}
-- by induction on X
:ind on (X:Nat) .
-- check
:apply (SI TC RD) .
--> QED
-- :describe proof
--> ================================================================

--> ================================================================
--> proof score for proving associativity of _+_:
-->   eq[+assoc]: (X:Nat + Y:Nat) + Z:Nat = X + (Y + Z) .
--> with the induction on X:Nat
--> ----------------------------------------------------------------
-- proof with CITP
select PNAT+ .
:goal{eq[+assoc]: (X:Nat + Y:Nat) + Z:Nat = X + (Y + Z) .}
-- by induction on X
:ind on (X:Nat) . 
-- check
:apply (SI TC RD) .
--> QED
-- :show proof
-- :desc proof
--> ================================================================

--> ----------------------------------------------------------------
--> PNAT with associative and commutative addition _+_
--> ----------------------------------------------------------------
mod! PNAT+ac {
pr(PNAT)
-- assoc and comm have been proved to hold
op _+_ : Nat Nat -> Nat {assoc comm}
-- definition of _+_
eq 0 + Y:Nat = Y .
eq (s X:Nat) + Y:Nat = s(X + Y) .
}

--> ----------------------------------------------------------------
--> PNAT with multiplication _*_
--> ----------------------------------------------------------------
mod! PNAT* {
pr(PNAT+ac)
op _*_ : Nat Nat -> Nat {prec: 40}
eq 0 * Y:Nat = 0 .
eq s X:Nat * Y:Nat = Y + X * Y .
}

--> ================================================================
--> proof score for proving right 0 of _*_:
-->   eq[*r0] X:Nat * 0 = X .
--> with the induction on X:Nat
--> ----------------------------------------------------------------
-- proof with CITP
select PNAT* .
:goal{eq[*r0]: X:Nat * 0 = 0 .}
-- by induction on X
:ind on (X:Nat) .
-- check
:apply (SI TC RD) .
--> QED
--> ================================================================

--> ================================================================
-- proof score for proving right s_ of _*_:
--   eq[*rs]: X:Nat * s Y:Nat = X + X * Y .
-- with the induction on X:Nat
-- -----------------------------------------------------------------
-- proof with CITP
select PNAT* .
:goal{eq[*rs]: X:Nat * (s Y:Nat) = X + (X * Y) .}
-- by induction on X
:ind on (X:Nat) .
-- check
:apply (SI TC RD) .
--> QED
--> ================================================================

--> ================================================================
--> proof score for proving commutativity of _*_:
-->   eq[*comm]: (X:Nat * Y:Nat) = (Y * X) .
--> with the induction on X:Nat
--> -----------------------------------------------------------------
-- proof with CITP
mod PNAT*comm {pr(PNAT*)
-- proved properties
eq[*r0]: X:Nat * 0 = 0 .
eq[*rs]: X:Nat * s Y:Nat = X + X * Y .
}
select PNAT*comm .
:goal{eq[*comm]: X:Nat * Y:Nat = Y * X .}
-- by induction on X
:ind on (X:Nat) .
-- check
:apply (SI TC RD) .
--> QED
--> ================================================================

--> ================================================================
--> proof score for proving distributivity of _*_ over _+_
--> from right:
-->   eq[*distr] (X:Nat + Y:Nat) * Z:Nat = X * Z + Y * Z .
--> with the induction on X:Nat
--> ----------------------------------------------------------------
-- proof with CITP
select PNAT* .
:goal{eq[*distr]: (X:Nat + Y:Nat) * Z:Nat = X * Z + Y * Z .}
-- by induction on X
:ind on (X:Nat) .
-- check
:apply (SI TC RD) .
--> QED
--> ================================================================

--> ================================================================
--> proof score for proving associativity of _*_:
-->   eq[*assoc]: (X:Nat * Y:Nat) * Z:Nat = X * (Y * Z) .
--> with the induction on X:Nat
--> ----------------------------------------------------------------
-- proof with CITP
mod PNAT*assoc
{pr(PNAT*)
-- proved property
eq[*distr]: (X:Nat + Y:Nat) * Z:Nat = (X * Z) + (Y * Z) .
}
select PNAT*assoc .
:goal{eq[*assoc]: (X:Nat * Y:Nat) * Z:Nat = X * (Y * Z) .}
-- by induction on X
:ind on (X:Nat) .
-- check
:apply (SI TC RD) .
--> QED
--> ================================================================

--> ----------------------------------------------------------------
--> Peano style natural numbers with assoc+comm _+_, _*_
--> which satisfy distributive law
--> ----------------------------------------------------------------
mod! PNAT*ac {
pr(PNAT+ac)
op _*_ : Nat Nat -> Nat {assoc comm prec: 40}
eq 0 * Y:Nat = 0 .
eq s X:Nat * Y:Nat = Y + X * Y .
-- distributive law
eq X:Nat * (Y:Nat + Z:Nat) = X * Y + X * Z .
}

--> ----------------------------------------------------------------
--> factorial functions on Nat.PNAT*ac
--> ----------------------------------------------------------------
mod! FACT {
pr(PNAT*ac)
-- one argument factorial function
op fact1 : Nat -> Nat .
eq fact1(0) = s 0 .
eq fact1(s N:Nat) = s N * fact1(N) .
-- two arguments factorial function
op fact2 : Nat Nat -> Nat .
eq fact2(0,N2:Nat) = N2 .
eq fact2(s N1:Nat,N2:Nat) = fact2(N1,s N1 * N2) .
}

--> ================================================================
--> proof score for the property:
-->   eq[f2f1]: fact2(N1:Nat,N2:Nat) = fact1(N1) * N2 .
--> with the induction on N1:Nat
--> ----------------------------------------------------------------
-- proof with CITP
select FACT .
:goal{eq[f2f1]: fact2(N1:Nat,N2:Nat) = fact1(N1) * N2 .}
-- by induction on X
:ind on (N1:Nat) .
-- check
:apply (SI TC RD) .
--> QED
--> ================================================================

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