--> ****************************************************************
--> 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
--> ================================================================
#|
-- ':describe proof' outputs the following
PNAT+> ==> root*
    -- context module: #Goal-root
    -- targeted sentence:
      eq [+rs]: X:Nat.PNAT + s Y:Nat.PNAT
          = s (X + Y) .
[si]    1*
    -- context module: #Goal-1
    -- targeted sentence:
      eq [+rs]: 0 + s Y:Nat.PNAT = s (0 + Y) .
[tc]    1-1*
    -- context module: #Goal-1-1
    -- discharged sentence:
      eq [RD TC +rs]: 0 + s Y@Nat = s (0 + Y@Nat) .
[si]    2*
    -- context module: #Goal-2
    -- assumption
      eq [SI +rs]: X#Nat + s Y:Nat.PNAT = s (X#Nat + Y) .
    -- targeted sentence:
      eq [+rs]: s X#Nat + s Y:Nat.PNAT = s (s X#Nat + Y) .
[tc]    2-1*
    -- context module: #Goal-2-1
    -- assumption
      eq [SI +rs]: X#Nat + s Y:Nat.PNAT = s (X#Nat + Y) .
    -- discharged sentence:
      eq [RD TC +rs]: s X#Nat + s Y@Nat = s (s X#Nat + Y@Nat) .
|#

--> ================================================================
--> 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
--> ================================================================
#|
-- ':describe proof' outputs the following
PNAT+comm> ==> root*
    -- context module: #Goal-root
    -- targeted sentence:
      eq [+comm]: X:Nat.PNAT + Y:Nat.PNAT
          = Y + X .
[si]    1*
    -- context module: #Goal-1
    -- targeted sentence:
      eq [+comm]: 0 + Y:Nat.PNAT = Y + 0 .
[tc]    1-1*
    -- context module: #Goal-1-1
    -- discharged sentence:
      eq [RD TC +comm]: 0 + Y@Nat = Y@Nat + 0 .
[si]    2*
    -- context module: #Goal-2
    -- assumption
      eq [SI +comm]: X#Nat + Y:Nat.PNAT = Y + X#Nat .
    -- targeted sentence:
      eq [+comm]: s X#Nat + Y:Nat.PNAT = Y + s X#Nat .
[tc]    2-1*
    -- context module: #Goal-2-1
    -- assumption
      eq [SI +comm]: X#Nat + Y:Nat.PNAT = Y + X#Nat .
    -- discharged sentence:
      eq [RD TC +comm]: s X#Nat + Y@Nat = Y@Nat + s X#Nat .
|#

--> ================================================================
--> 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
--> ================================================================
#| 
-- ':show proof' outputs the following
PNAT+> root*
[si]  1*
[tc]  1-1*
[si]  2*
[tc]  2-1*

-- ':describe proof' outputs the following
PNAT+> ==> root*
    -- context module: #Goal-root
    -- targeted sentence:
      eq [+assoc]: (X:Nat.PNAT + Y:Nat.PNAT) + Z:Nat.PNAT
          = X + (Y + Z) .
[si]    1*
    -- context module: #Goal-1
    -- targeted sentence:
      eq [+assoc]: (0 + Y:Nat.PNAT) + Z:Nat.PNAT
          = 0 + (Y + Z) .
[tc]    1-1*
    -- context module: #Goal-1-1
    -- discharged sentence:
      eq [RD TC +assoc]: (0 + Y@Nat) + Z@Nat
          = 0 + (Y@Nat + Z@Nat) .
[si]    2*
    -- context module: #Goal-2
    -- assumption
      eq [SI +assoc]: (X#Nat + Y:Nat.PNAT) + Z:Nat.PNAT
          = X#Nat + (Y + Z) .
    -- targeted sentence:
      eq [+assoc]: (s X#Nat + Y:Nat.PNAT) + Z:Nat.PNAT
          = s X#Nat + (Y + Z) .
[tc]    2-1*
    -- context module: #Goal-2-1
    -- assumption
      eq [SI +assoc]: (X#Nat + Y:Nat.PNAT) + Z:Nat.PNAT
          = X#Nat + (Y + Z) .
    -- discharged sentence:
      eq [RD TC +assoc]: (s X#Nat + Y@Nat) + Z@Nat
          = s X#Nat + (Y@Nat + Z@Nat) .
|#

--> ----------------------------------------------------------------
--> 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
:desc proof
--> ================================================================
#|
-- ':describe proof' outputs the following
PNAT*comm> ==> root*
    -- context module: #Goal-root
    -- targeted sentence:
      eq [*comm]: X:Nat.PNAT * Y:Nat.PNAT
          = Y * X .
[si]    1*
    -- context module: #Goal-1
    -- targeted sentence:
      eq [*comm]: 0 * Y:Nat.PNAT = Y * 0 .
[tc]    1-1*
    -- context module: #Goal-1-1
    -- discharged sentence:
      eq [RD TC *comm]: 0 * Y@Nat = Y@Nat * 0 .
[si]    2*
    -- context module: #Goal-2
    -- assumption
      eq [SI *comm]: X#Nat * Y:Nat.PNAT = Y * X#Nat .
    -- targeted sentence:
      eq [*comm]: s X#Nat * Y:Nat.PNAT = Y * s X#Nat .
[tc]    2-1*
    -- context module: #Goal-2-1
    -- assumption
      eq [SI *comm]: X#Nat * Y:Nat.PNAT = Y * X#Nat .
    -- discharged sentence:
      eq [RD TC *comm]: s X#Nat * Y@Nat = Y@Nat * s X#Nat .
|#

--> ================================================================
--> 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
:desc proof
--> ================================================================
#|
-- ':describe proof' outputs the following
FACT> ==> root*
    -- context module: #Goal-root
    -- targeted sentence:
      eq [f2f1]: fact2(N1:Nat.PNAT, N2:Nat.PNAT)
          = fact1(N1) * N2 .
[si]    1*
    -- context module: #Goal-1
    -- targeted sentence:
      eq [f2f1]: fact2(0, N2:Nat.PNAT) = fact1(0) * N2 .
[tc]    1-1*
    -- context module: #Goal-1-1
    -- discharged sentence:
      eq [RD TC f2f1]: fact2(0, N2@Nat) = fact1(0) * N2@Nat .
[si]    2*
    -- context module: #Goal-2
    -- assumption
      eq [SI f2f1]: fact2(N1#Nat, N2:Nat.PNAT)
          = fact1(N1#Nat) * N2 .
    -- targeted sentence:
      eq [f2f1]: fact2(s N1#Nat, N2:Nat.PNAT)
          = fact1(s N1#Nat) * N2 .
[tc]    2-1*
    -- context module: #Goal-2-1
    -- assumption
      eq [SI f2f1]: fact2(N1#Nat, N2:Nat.PNAT)
          = fact1(N1#Nat) * N2 .
    -- discharged sentence:
      eq [RD TC f2f1]: fact2(s N1#Nat, N2@Nat)
          = fact1(s N1#Nat) * N2@Nat .
|#

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